BCI NET 2/BCI NET 2.iso/archives/telecomm/bbs/bbbbs84.lha/rexx/BBBBS.baud

Text File | 1994-12-21 | 149.4 KB | 5,789 lines

/*               $VER: BBBBS.baud 8.3 (21.12.94)
 BBBBS.baud 8.3 © 1990-94 Richard Lee Stockton 21 Dec 94 1:56PM
     - FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS -

     BBBBS.baud. A full-featured BBS in ARexx for Baudbandit
based on 'Answer.baud'. Thanks to Greg Cunningham for BaudBandit!
     See BBBBS.guide and rexx/bbsLOCAL.rexx for install info
*/

saypath='SYS:Utilities/Say'

/* If QuickSortPort not found then try to run setup.rexx */

IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
IF ~SHOW('P','QuickSortPort') THEN EXIT 666

IF SHOW('P','BBBBS') THEN
  DO
    SAY 'BBBBS is already running!'
    EXIT 0
  END

CALL OPENPORT('BBBBS')

RESET:
CALL SETCLIP('BBS_RESET')
copyright.=''
copyright.1=STRIP(SOURCELINE(2))
copyright.2='
Gramma Software 21305-60th Ave West, Mountlake Terrace WA 98043-2009'
copyright.3='
ARexx portions of this software copyright 1990-94 Richard Lee Stockton'
copyright.4='- FREELY DISTRIBUTABLE as long as this notice remains -'

CALL SETCLIP('BBS_version',copyright.1)
CALL SETCLIP('BBS_localfiles')
CALL SETCLIP('BBS_localusers')
CALL SETCLIP('BBS_interpret')
CALL SETCLIP('BBS_FULLCALL')
CALL SETCLIP('BBS_MESSAGE')
CALL SETCLIP('BBS_BROWSE')
CALL SETCLIP('BBS_MSGS')
CALL SETCLIP('BBS_QUIT')

/* try to trap everything */

OPTIONS RESULTS
OPTIONS FAILAT 999999
NUMERIC DIGITS 14
SIGNAL ON HALT
SIGNAL ON SYNTAX
SIGNAL ON FAILURE
SIGNAL OFF BREAK_C
SIGNAL OFF BREAK_E

PARSE VERSION . . cpu .
cpu=RIGHT(cpu,2)/10
IF cpu<1 THEN cpu=1
Status Vers
BB_VERS=RESULT
bm=50
IF RIGHT(BB_VERS,4)>1.59 THEN bm=25
dcd
IF RC=0 THEN Send 'ATH1\r'

bbsprefs.=0  /* start with all prefs OFF */
namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
alpha.=''
logonflag=1
emailonline=-1
CALL zerovars()

/* User data structure by line */

text.=''
text.1='   Full Name'
text.2='      Street'
text.3='City, ST Zip'
text.4=' Voice Phone'
text.5='    Password'
text.6='    Protocol'
text.7='LinesPerPage'
text.8=' Preferences'
text.9='    Computer'
text.10='   Interests'
text.11='Session Time'
text.12='FirstSession'
text.13='Last Session'
text.14='      UpLoad'
text.15='    Download'
text.16='   Last File'
text.17='Ratio  Email'
text.18='    Winnings'
text.19='       Usage'
text.20='       Level'
text.21='Exclude DIRS'
text.22='   Msgs Read'
text.23='   Msgs Writ'
text.24=' Marked Msgs'
text.25='Marked Files'
text.26='QUICKexclude'
text.27=' CBV numbers'


name=''
CR='0D'x
LF='0A'x
lineup='1B'x'M'
lm='Loading Module...'lineup||CR
SAY CR
SAY CENTER(copyright.1,75)||CR

CALL PRAGMA('W','N')
CALL config()
IF bbsprefs.15~=0 THEN
  CALL send2log('===== BBBBS started' DATE('W') DATE() TIME('C') '=====')

IF ~EXISTS(bbspath'Numbers/FirstLogon') THEN
  ADDRESS COMMAND 'C:Date >'bbspath'Numbers/FirstLogon'

SAY CENTER(copyright.2,75)||CR

/* open printer? */
IF bbsprefs.3 THEN
  DO
    IF ~OPEN(p,'PRT:','W') THEN
      DO
        CALL send2log('failed to open printer.')
        bbsprefs.3=0
      END
  END

/* CALL PRAGMA('W','W')   <-- UN-COMMENT THIS LINE TO ENABLE REQUESTERS */
CALL colors(1)
Capture OFF
Timeout 120
SAY CENTER(copyright.3,75)||CR

excuses.=''
courtesy=''
courtesyflag=0
SAY CENTER(copyright.4,75)||CR
SAY CR
SAY CR
SAY CENTER('Setting up, please wait...',75)||CR
SAY CR

msg.=''
IF readopen(bbspath'Lists/Conferences') THEN
  DO
    DO i=1
      line=READLN(f)
      IF line='END' THEN BREAK
      IF EOF(f) THEN BREAK
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN msg.num=WORD(line,2)
    END
    CALL CLOSE(f)
  END

dirs.=''
IF readopen(bbspath'Lists/Libraries') THEN
  DO
    DO i=1
      line=READLN(f)
      IF line='END' | EOF(f) THEN LEAVE i
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN dirs.num=STRIP(WORD(line,2))
    END
    CALL CLOSE(f)
  END

users=0
CALL sortuserlist()

SAY CR
SAY '          The larger the BBS gets, the longer it takes to setup...'CR
CALL loadfiles()
dcd
IF RC~=0 & bbsprefs.15>0 THEN
  DO
    SAY CR
    SAY '      If it seems to take forever, ask the sysop to try' pen3'Resident'def 'mode.'CR
  END
SAY CR
CALL set_grand()
CALL loadalpha(1)

dcd
IF RC=0 THEN
  DO
    logonflag=0
    SIGNAL DONE
  END

LOGON:
CALL checkdcd()
bps=0
SetMark 'CONNECT'
IF RC=1 THEN
  DO
    GetLine
    connectline=RESULT
    PARSE VAR connectline 'CONNECT'bps
    CALL STRIP(bps)
    DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
    END
    bps=LEFT(bps,i-1)
  END
IF bps<300 | bps>38400 THEN
  DO
    SetMark 'CARRIER'
    IF RC=1 THEN
      DO
        GetLine
        connectline=RESULT
        PARSE VAR connectline 'CARRIER'bps
        CALL STRIP(bps)
      END
    ELSE bps='000 '
  END
DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
END
bps=LEFT(bps,i-1)
SIGNAL ON BREAK_C
SIGNAL OFF BREAK_E
REMOTE ON
TimeOut 120
IF bps<300 THEN bps=getbaudrate()
IF bps<300 THEN SIGNAL DONE
bps=bps%1
IF logonflag=0 THEN
  DO
    logonflag=1
    DO i=1 TO 7
      SAY '  'CR
    END
    DO i=1 TO 4
      SAY CENTER(copyright.i,75)||CR
    END
    CALL sound('LOGON')
    CALL DELAY(150)
    SAY CR
    SAY CR
    SAY CR
  END
colorflag=1
CALL colors(1)

IF alpha.0='' THEN CALL loadalpha(1)

CALL TIME('R')

/** Identify (title) message */
IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN
  DO
    nonstop=1
    CALL showtext(bbspath'BBS_TEXT/HELLO' 0)
    nonstop=0
  END
SAY CR

SAY 'Running on' BB_VERS 'at' bps 'baud. ' TIME('C') DATE('W') DATE()||CR
Stat 'Z'
CALL checkdcd()

/* Ask for name */
name=''
courtesy=''
Queue CR
DO count=1 TO 3
  name=getinput(1 0 'Please enter name: ')
  name=cleanstring(1':'name)
  IF name='NEW' THEN LEAVE count
  IF name~='' THEN
    DO
      IF EXISTS(bbspath'Users/'name) THEN LEAVE count
      IF EXISTS(bbspath'Morgue/'name'.lha') THEN
        DO
          SAY CR
          SAY name 'used to be a member of this BBS.'CR
          SAY 'If that is you, and you recall your password, you may resurrect yourself...'CR
          IF getinput(1 1 'Resurrect' name'? (Ny) > ')='Y' THEN
            DO
              dd=WORD(STATEF(bbspath'Morgue/'name'.lha'),5)
              dd=DATE(,dd,'I')
              SAY 'Resurrecting a dead user.  Killed' dd '...'CR
              ADDRESS COMMAND 'CD' bbspath'0A'x||'lha x Morgue/'name'.lha'
              CALL DELETE(bbspath'Morgue/'name'.lha')
              CALL send2log('RESURRECTED:' name 'who was killed' dd)
              sortuserflag=1
              CALL sound('NEW_USER')
              LEAVE count
            END
        END
      IF FIND(exclusion,name)>0 THEN
        DO
          SAY 'Sorry, that is a reserved name.'CR
          name=''
          ITERATE count
        END
      CALL loadcourtesy()
      IF bbsprefs.7>0 | FIND(courtesy,name)>0 THEN
        DO
          SAY CR
          SAY 'Welcome' name'!'CR
          SAY 'You will be automatically validated after you enter your user info.'CR
          SAY CR
          LEAVE count
        END
    END
  IF count<3 THEN
    DO
      IF STRIP(name)~='' THEN SAY name 'not found.  Please try again.'CR
      SAY 'New Users enter NEW to apply for validation.'CR
    END
END
IF count>3 THEN SIGNAL DONE
CALL TIME('R')
logontime=TIME('C')
line=left(name,16,' ') 'logged in  at' time('C') date('W') date() 'at' bps 'baud'
CALL send2log(line)
CALL checkUser()
x=GETCLIP('BBS_FULLCALL')
CALL SETCLIP('BBS_FULLCALL')
IF WORD(x,1)=name & level<sysoplevel THEN
  DO
    mins=TIME('M')-WORD(x,2)
    IF mins<0 THEN mins=mins+1440
    IF mins<bbsprefs.26 THEN
      DO
        SAY CR
        SAY bak2'*** Please wait at least' bbsprefs.26 'minutes between calls ***'def||CR
        SAY CR
        CALL SETCLIP('BBS_FULLCALL',x)
        SIGNAL LOGOUT2
      END
  END
IF UPPER(WORD(data.12,3))~='BIRTHDAY:' THEN
  DO
    SAY CR
    SAY 'Please help us out by entering the following information.'CR
    CALL getbirth()
    SAY '   Thank you!'CR
  END
prevcaller=''
prevcaller=GETCLIP('BBS_lastcaller')
IF prevcaller~='' THEN CALL SETCLIP('BBS_prevcaller',prevcaller)
city=docity(data.3)
CALL SETCLIP('BBS_lastcaller',name city'  'TIME('C') DATE())
CALL SETCLIP('BBS_level',level)
CALL postuser(0)
Timeout maxidle         /* max idle time at prompts */

IF RIGHT(WORD(data.12,4),4)=RIGHT(DATE('S'),4) THEN
  DO
    arg=bbspath'BBS_TEXT/BIRTHDAY'
    IF EXISTS(arg) THEN
      DO
        SAY CR
        CALL showtext(arg 1)
      END
    SAY CR
    SAY '***  Happy Birthday,' pen3||data.1||def', and many more!  ***'CR
  END
SAY CR

/* Get current protocol */
Status Trans
protocol=STRIP(RESULT)

IF bbsLOGON.baud(name level)=1 THEN SIGNAL OUT
CALL checkdcd()
CALL sortlibraries()
CALL sortconferences()
IF FIND(data.8,'QUICK')>0 THEN
  DO
    logonflag=0
    CALL do_quick(0)
    logonflag=1
  END

/*
Opening Display after logon. Seen by all Users ONCE A DAY. It first
looks for a unique yearly data (ie, WELCOME.0704), then daily data
(ie, WELCOME.Fri), and then a simple, everyday 'WELCOME' datafile.
*/

CALL postfour('Logon Messages')

IF DATE('I')>lastondate THEN
  DO
    SAY CR
    arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4)
    CALL showtext(arg 1)
    SAY CR
    arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3)
    CALL showtext(arg 1)
    SAY CR
    arg=bbspath'BBS_TEXT/WELCOME'
    CALL showtext(arg 1)

/*
Looks for files in the format BAUD.baudrate, ie "BAUD.2400" will only
be seen by users logging on at 2400 baud.
*/

    arg=bbspath'BBS_TEXT/BAUD.'bps
    IF EXISTS(arg) THEN
      DO
        SAY CR
        CALL showtext(arg 1)
      END

/*
Looks for files in the format  LEVEL.low-high, ie "LEVEL.50-80" will only
be seen by users with a level >= 50 and <= 80.
*/

    levels.=''
    IF FileList(bbspath'BBS_TEXT/LEVEL.*',levels)>0 THEN
      DO
        DO ui=1 TO levels.0
          p=LASTPOS('.',levels.ui)
          x=SUBSTR(levels.ui,p+1)
          PARSE VAR x lo'-'hi .
          IF ~DATATYPE(lo,'W') | ~DATATYPE(hi,'W') THEN ITERATE ui
          IF lo>level | hi<level THEN ITERATE ui
          DO
            SAY CR
            CALL showtext(levels.ui 1)
          END
        END
      END

/*
Looks for format UNTIL.YYYYMMDD ie, "UNTIL.19920514"
Deletes any that are previous to "today"
*/

    untils.=''
    IF FileList(bbspath'BBS_TEXT/UNTIL.*',untils)>0 THEN
      DO
        CALL QSORT(1,untils.0,untils)
        DO ui=1 TO untils.0
          IF RIGHT(untils.ui,8)<DATE('S') THEN CALL DELETE(untils.ui)
          ELSE
            DO
              SAY CR
              CALL showtext(untils.ui 1)
            END
        END
      END
    DROP levels. untils.
  END

IF bbsprefs.1 & ~terseflag THEN
  DO
    IF doGrin()>3 THEN CALL waiting()
    IF EXISTS(bbspath'rexxDoors/Moon.rexx') THEN CALL Moon.rexx()
    IF EXISTS(bbspath'rexxDoors/Time.rexx') THEN CALL Time.rexx()
    IF FIND(UPPER(SHOWLIST('A')),'TODAY')>0 THEN
      DO
        tf=scratch'/TODAY'
        IF EXISTS(tf) THEN
          DO
            finfo=STATEF(tf)
            IF WORD(finfo,5)~=DATE('I') THEN
              ADDRESS COMMAND 'C:Today091 >'tf
          END
        ELSE ADDRESS COMMAND 'C:Today091 >'tf
        CALL showtext(tf 0)
      END
    SAY CR
  END

IF SHOWDIR(bbspath'Email/'name)~='' THEN CALL readmail(0)
ELSE SAY 'Your mailbox is empty.'CR
IF ~terseflag THEN
  DO
    IF level>sysoplevel THEN
      DO
        lstmail=WORD(data.17,3)
        IF ~DATATYPE(lstmail,'W') THEN lstmail=0
        IF countcheck('Numbers/LastMail' 0)>lstmail THEN
          IF getinput(1 1 'Check Email? (Ny) > ')='Y' THEN CALL mailreport()
        IF level<99 THEN
          DO
            SAY CR
            CALL showtext(bbspath'Email/'sysop'/NEW_FILES' 1)
          END
        SAY CR
        CALL showtext(bbspath'Lists/NEW_USERS' 1)
        CALL showtext(bbspath'Lists/CBV_USERS' 1)
      END
    CALL logonstats()
    CALL newinfo()
  END
CALL showmarked(1)
CALL setdir(libpath||dirs.1)
logonflag=0


/***** MAIN *****/

IF menu~='ALL' THEN menu='MAIN'

RESTART:
IF name='' | data.20='' | logonflag THEN SIGNAL LOGON  /* login was interrupted */
SIGNAL ON BREAK_C
SIGNAL ON BREAK_E

waitchar=''
string=''
opt=''
IF level<1 THEN menu='NEW'
DO WHILE(opt~='G')
  go=0
  uldlflag=0
  DO WHILE(~go)
    IF waitchar='' | waitchar='?' THEN
      DO
        commands='ceghiqrsvwxyz!#,'
        IF level>0  THEN commands='abcdefghijlmnoprstuvwxyz!$#&+,.'
        IF level>sysoplevel THEN commands=commands'k%^()=;'
        IF level=99 THEN commands=commands'@~'
        commands=commands'?'
        IF menuflag | waitchar='?' | string='?' THEN CALL menus()
        ELSE SAY pen3'COMMANDS:'def commands||CR
        opt='MENU'
        arg=''
        CALL postuser(1)
        IF level=0 THEN
          IF SHOWDIR(bbspath'Email/'name)~='' THEN
            DO
              SAY 'You have new Email waiting! - Enter E to read your [E]mail'CR
              SAY CR
            END
      END
    CALL showtime()
    line=''
    line=line||bak2' 'TIME('C')' 'def
    IF menu='ALL' | menu='FILE' THEN
      line=line pen3'FILE_LIBRARY:'plaindir||def
    ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def
    ELSE line=line pen3'MAIN:'def
    line=line'  'bbsname
    IF waitchar='' THEN waitchar=getinput(0 0 line' > ')
    PARSE VAR waitchar string' 'arg
    CALL checkdcd()
    nonstop=0
    string=UPPER(STRIP(string))
    IF clr~='' THEN Send clr
    IF POS('+++',string)>0 THEN SIGNAL OUT
    IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT2
    IF string='FL' & level>0 THEN
      DO
        CALL bbsFriends.rexx(name colorflag)
        string=''
      END
    CALL checkalias()
    IF LEFT(string,1)='D' THEN
      IF DATATYPE(SUBSTR(string,2),'W') THEN arg=SUBSTR(string,2) arg
    waitchar=''
    warnings=0
    IF DATATYPE(string,'W') THEN
      DO
        IF string>level THEN
          DO
            arg=STRIP(string arg)
            string='D'
          END
        ELSE
          DO
            dirnum=string
            CALL chdir2()
            CALL since()
          END
      END
    IF string='QUICK' & level>0 THEN CALL do_quick(1)
    opt=LEFT(string,1)
    IF opt='G' THEN
      DO
        IF getinput(1 1 pen3'Logoff? (nY) > 'def)='N' THEN opt='?'
      END
    go=1    /* check for access */
    t=bbspath'BBS_TEXT/COM.'opt
    IF UPPER(arg)='EDIT' & level>sysoplevel THEN
      DO
        CALL edinfo(t,opt,'Menu Command')
        opt=''
      END
    IF ~terseflag THEN CALL showtext(t 1)
    IF POS(opt,UPPER(commands))=0 THEN go=0
  END
  IF CBVflag=1 THEN SIGNAL OUT
  CALL postuser(1)
  OPTIONS PROMPT 'Filename: '
  SELECT
    WHEN opt='A' THEN CALL showalpha()
    WHEN opt='B' THEN CALL browse()
    WHEN opt='C' THEN CALL editor(name maxtime-TRUNC(TIME('E')) 'MAIL' sysop . 0 0 'FEEDBACK')
    WHEN opt='D' THEN CALL dload()
    WHEN opt='E' THEN CALL readmail(level>0)
    WHEN opt='F' THEN CALL do_F()
    WHEN opt='H' THEN CALL help('MAIN')
    WHEN opt='I' THEN CALL information()
    WHEN opt='J' THEN CALL jump2rexx()
    WHEN opt='K' THEN CALL killuser()
    WHEN opt='L' THEN CALL list()
    WHEN opt='M' THEN IF menu~='ALL' THEN menu='MSG'
    WHEN opt='N' THEN CALL newfiles()
    WHEN opt='O' THEN CALL otheruser()
    WHEN opt='P' THEN CALL editor(name maxtime-TRUNC(TIME('E')) 'MSG' . . 0 0)
    WHEN opt='R' THEN IF menu='NEW' THEN CALL CBV();ELSE CALL readmessages()
    WHEN opt='S' THEN CALL bbsSEARCH()
    WHEN opt='T' THEN CALL chpro()
    WHEN opt='U' THEN CALL uload(1)
    WHEN opt='V' THEN CALL showtext(bbspath'Usage/USER.LOG' 1)
    WHEN opt='W' THEN CALL showuserlist()
    WHEN opt='X' THEN CALL switchmenuflag()
    WHEN opt='Y' THEN CALL edituser()
    WHEN opt='Z' THEN CALL counts()
    WHEN opt='~' THEN CALL sysED(1)
    WHEN opt='!' THEN CALL yell()
    WHEN opt='@' THEN CALL shell()
    WHEN opt='#' THEN CALL switchcolors()
    WHEN opt='$' THEN IF menu='ALL' THEN menu='MAIN'; ELSE menu='ALL'
    WHEN opt='%' THEN CALL editnote()
    WHEN opt='^' THEN CALL readlogs()
    WHEN opt='&' THEN CALL bbsProfiles.rexx(name level sysoplevel linesperpage colorflag maxtime-TIME('E') bbspath)
    WHEN opt='+' THEN CALL ext_dload()
    WHEN opt='(' THEN CALL filereport()
    WHEN opt=')' THEN CALL mailreport()
    WHEN opt='=' THEN CALL levelreport()
    WHEN opt=';' THEN CALL changename()
    WHEN opt=',' THEN DO;CALL hourly();CALL waiting();END
    WHEN opt='.' THEN IF menu~='ALL' THEN menu='MAIN'
    WHEN opt='?' THEN IF menuflag THEN CALL help('MAIN')
    OTHERWISE NOP
  END
END
SIGNAL LOGOUT
EXIT



/* FUNCTIONS */


do_F:
IF menu='FILE' | menu='ALL' THEN
  DO
    IF STORAGE()<(bbsprefs.15+100000) | GETCLIP('BBS_libs.0')~='' THEN
      DO
        SAY CR
        SAY 'Sorry! Not enough memory left for background archiving.'CR
        SAY 'Please try again in 10 minutes or so.'CR
        SAY CR
        RETURN
      END
    DO i=0 TO libs.0
      CALL SETCLIP('BBS_libs.'i,libs.i)
    END
    IF Make_BrowseList.baud(name colorflag files.0)=0 THEN
      DO
        CALL send2log('Arc: Make_BrowseList.baud')
        IF emailonline>=0 THEN emailonline=emailonline+1
      END
    DO i=0 TO libs.0
      CALL SETCLIP('BBS_libs.'i)
    END
  END
ELSE IF menu~='ALL' THEN menu='FILE'
RETURN


cleanstring:
PARSE ARG nflag':'cstr
IF nflag=1 THEN
  DO
    cstr=COMPRESS(cstr,"'`")
    cstr=TRANSLATE(cstr,,namemask)
    cstr=SPACE(cstr,1,'_')
    RETURN cstr
  END
bot=XRANGE(,'1F'x)
IF nflag=2 THEN bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
ELSE cstr=strip_ansi(cstr)
top=XRANGE('7F'x)
cstr=COMPRESS(cstr,bot||top)
IF nflag=0 THEN cstr=STRIP(cstr)
RETURN cstr


showtext:
PARSE ARG starg warg .
IF EXISTS(starg) THEN
  DO
    CALL readlines(starg 1)
    IF colorflag=0 THEN CALL strip_lynes()
    CALL seelines(1)
    IF warg THEN
      DO
        CALL waiting()
        nonstop=0
      END
  END
RETURN


strip_lynes:
DO i=1 TO lynes.0
  lynes.i=strip_ansi(lynes.i)
END
RETURN


strip_ansi:
PARSE ARG aline
n=POS('1B'x,aline)
DO WHILE n>0
  DO k=2
    IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
      leave k
  END
  aline=DELSTR(aline,n,k+1)
  n=POS('1B'x,aline)
END
RETURN aline


doGrin:
IF ~EXISTS(bbspath'rexxDoors/Grin_du_Jour.rexx') THEN RETURN 0
CALL setdir(bbspath'rexxDoors')
temp=Grin_du_Jour.rexx()
SAY CR
RETURN temp


send2log:
PARSE ARG sendline
logfile=bbspath'Logs/log.'DATE('S')    /* daily logs */
fl='W'
IF EXISTS(logfile) THEN fl='A'
IF ~OPEN('log',logfile,fl) THEN
  DO
    IF ~OPEN('log',logfile,fl) THEN
      DO
        SAY 'failed to open log file'
        RETURN
     END
  END
CALL WRITELN('log',sendline)
CALL CLOSE('log')
IF bbsprefs.3=1 THEN CALL WRITELN(p,sendline)
RETURN


send2last:
PARSE ARG sendline
IF bbsprefs.24~=1 & name=sysop THEN RETURN
ADDRESS AREXX bbsLog99.rexx 'USER' sendline
RETURN


do_quick:
ARG flag .
CALL postfour('QUICK:')
IF FIND(UPPER(data.8),'QUICK')=0 THEN
  DO
    SAY CR
    SAY 'The QUICK option is OFF in your current settings.'CR
    SAY CR
    SAY 'Setting the QUICK option to ON will allow you to tell the BBS to'CR
    SAY 'make a .lha archive of all new bbs activity since your last call.'CR
    SAY CR
    SAY 'This archive can then be read (and replied to, and files can be'CR
    SAY 'uploaded and downloaded) using 'pen3'bbsQUICK.rexx'def', the offline read/reply'CR
    SAY 'module for BBBBS, which is available here in the file libraries.'CR
    SAY CR
    IF getinput(1 1 'Turn the QUICK option ON? (Ny) > ')~='Y' THEN RETURN
    data.8=data.8 'QUICK'
    CALL savedata(0)
  END
ELSE IF flag=1 THEN
  DO
    IF getinput(1 1 'Turn the QUICK option OFF? (Ny) > ')='Y' THEN
      DO
        temp=data.8
        data.8=''
        DO i=1 TO WORDS(temp)
          IF WORD(temp,i)~='QUICK' THEN data.8=STRIP(data.8 WORD(temp,i))
        END
        ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/QUICK_#?'
        RETURN
      END
  END
IF getinput(1 1 'Edit your QUICK exclude list? (Ny) > ')='Y' THEN
  DO
    SAY CR
    SAY 'You may EXCLUDE any of these from your QUICK archives.'CR
    SAY pen3||LEFT('-',74,'-')||def||CR
    temp=LEFT(' ',7)
    SAY temp'HELLO          - Pre-logon message.'CR
    SAY temp'WELCOME        - Post-logon message.'CR
    SAY temp'GOODBYE        - Logoff message.'CR
    SAY temp'HOURLY         - Average-Minutes-Per-Hour usage graph.'CR
    SAY temp'STATS.BBS      - Most of the Z command from the main menu.'CR
    SAY temp'filename       - ANY filename in the Information area.'CR
    SAY temp'MESSAGES       - New conference messages.'CR
    SAY temp'FILELIST       - New file descriptions.'CR
    SAY pen3||LEFT('-',74,'-')||def||CR
    SAY 'Enter a space separated list of what you wish to exclude.'CR
    SAY pen3'Exclude:'def data.26||CR
    temp=getinput(1 0 pen3'Exclude: 'def)
    IF temp='' & data.26~='' THEN
      DO
        IF getinput(1 1 'Clear the QUICK exclude list? (nY) > ')~='N' THEN
          data.26=''
      END
    ELSE data.26=temp
    temp='Your QUICK archives will exclude'pen3
    IF data.26='' THEN temp=temp 'nothing!'
    ELSE temp=temp data.26
    SAY temp||def||CR
    CALL savedata(0)
    SAY CR
  END
IF GETCLIP('BBS_'name)~='' THEN
  DO
    SAY CR
    SAY 'The QUICK routines are still working on your archive...'CR
    SAY 'Please try again later.'CR
    SAY CR
    RETURN
  END
quickdir=bbspath'EmailFiles/'name
CALL MAKEDIR(quickdir)
CALL setdir(quickdir)
qdarg=scratch'/dirlist'
ADDRESS COMMAND 'C:list >'qdarg quickdir'/QUICK_#? DATES'
efiles=UPPER(SHOWDIR(quickdir))
qflag=0
das=0
IF getinput(1 1 'Archive new BBS activity now? (Ny) > ')='Y' THEN
  DO
    das=1
    DO i=1 TO WORDS(efiles)
      IF LEFT(WORD(efiles,i),6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN
        DO
          SAY CR
          SAY 'There is already a QUICK_xxxxx.LHA file in your mailbox...'CR
          SAY 'Activity request has been CANCELLED!'CR
          SAY CR
          das=0
          LEAVE i
        END
    END
  END
IF das=1 THEN
  DO
    CALL SETCLIP('BBS_city',city)
    CALL SETCLIP('BBS_'name'_26',data.26)
    IF FIND(UPPER(data.26),'STATS.BBS')=0 THEN
      CALL SETCLIP('BBS_statsarg',emailonline grand grand2 files.0)
    IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
      CALL SETCLIP('BBS_'name'_22',data.22)
    CALL MAKEDIR(bbspath'EmailFiles/'name)
    CALL showmarked(0)
    CALL SETCLIP('BBS_QUICKOUT_BAUD',bps)
    ADDRESS AREXX bbsQUICKOUT.rexx name level lastbrowse WORD(data.16,2) data.21
    CALL send2log('Started QUICKOUT at' TIME('C'))
    SAY CR
    IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
      DO
        clear_marked=1
        DO i=1 TO level
          IF WORD(data.22,i)~=-1 THEN
            lastread.i=countcheck('Numbers/LastMessage'i 0)
        END
        SAY CR
      END
    IF FIND(UPPER(data.26),'FILELIST')=0 THEN
      lastbrowse=countcheck('Numbers/LastFile' 0)
    newfilesdate=DATE('S') TIME()
    IF writeopen(bbspath'EmailFiles/'name'/Libraries') THEN
      DO
        DO i=1 TO libs.0
          CALL WRITELN(f,libs.i)
        END
        CALL CLOSE(f)
      END
    IF writeopen(bbspath'EmailFiles/'name'/Conferences') THEN
      DO
        DO i=1 TO msgs.0
          CALL WRITELN(f,msgs.i)
        END
        CALL CLOSE(f)
      END
    SAY CR
    CALL savedata(1)
    qflag=1
  END
IF WORD(STATEF(qdarg),2)>80 THEN
  DO
    CALL showtext(qdarg 0)
    SAY CR
  END
DO qi=1 TO WORDS(efiles)
  qarg=WORD(efiles,qi)
  IF LEFT(qarg,6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN
    DO
      SAY qarg 'is' WORD(STATEF(qarg),2) 'bytes.'CR
      allargs=qarg
      DO WHILE dload2()=1
      END
      t=''
      DO WHILE t~='N' & t~='Y'
        t=getinput(1 1 'Delete' qarg'? (ny) > ')
      END
      IF t='Y' THEN
        DO
          IF DELETE(quickdir'/'qarg)=1 THEN SAY qarg 'deleted.'CR
          CALL DELETE(quickdir'/'qarg'.xdl')
          qarg=COMPRESS(UPPER(qarg),'QUICK_.LHA')
          CALL DELETE(bbspath'Email/'name'/BBBBS.'qarg)
        END
    END
END
arg=''
IF getinput(1 1 'Do you have a QUICKIN file to upload? (Ny) > ')='Y' THEN
  DO
    arg='QUICKIN.lha'
    ul=2
    DO WHILE ul=2
      ul=uload(0)
    END
  END
IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') & level>=sysoplevel THEN
  IF getinput(1 1 'Process your QUICKIN archive [N]ow or at [L]ogoff? (Ln) > ')='N' THEN
    DO
      ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
      SAY CR
      SAY 'Processing QUICKIN archive...'CR
    END
IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN
  DO
    IF qflag THEN SAY 'Your archive will be waiting next time you call...'CR
    SAY CR
    SIGNAL LOGOUT2
  END
IF qflag THEN
  DO
    SAY CR
    SAY 'Note: You now have no ''new'' files or messages (they are being archived).'CR
    SAY CR
    SAY 'You will be signaled if you are still online when your archive is ready...'CR
    SAY CR
    CALL waiting()
  END
CALL setdir(libpath||dirs.1)
RETURN


killuser:
ARG kname .
IF level<=sysoplevel THEN RETURN
CALL bbsKillUser.rexx(kname)
RETURN


menus:
CALL checkdcd()
IF OPEN(f,bbspath'BBS_TEXT/MENU_'menu'.'colorflag,'R')~=0 THEN
  DO
    m=READCH(f,65000)
    CALL CLOSE(f)
    SAY m
    IF level>sysoplevel THEN
      DO
        SAY ' ['pen3'K'def']ill a user      ['pen3'%'def'] edit filenote  ['pen3'='def'] level report'def||CR
        SAY ' ['pen3'^'def'] view BBS logs  ['pen3'('def'] file report    ['pen3';'def'] change username'def||CR
      END
    IF level=99 THEN
      SAY ' ['pen3'~'def'] online editor  ['pen3'@'def'] dos shell      ['pen3')'def'] email report'def||CR
  END
ELSE IF menu='NEW' THEN
  DO
    SAY pen6'     _________________'def||CR
    SAY pen6'  __/  'pen3'New User Menu'pen6'  \___'def||CR
    SAY pen6' |                        |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'I'def']nformation        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'W'def']ho is here        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch user list   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'X'def'] toggle menus     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'#'def'] toggle color     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
    SAY pen6' |________________________|'def||CR
    IF bbsprefs.22~=0 THEN
      DO
        SAY CR
        SAY 'Local Callers may register and receive' pen7'INSTANT VALIDATION'def'!'CR
        SAY 'Enter R to ['pen3'R'def']egister using Call Back Verify.'CR
      END
  END
ELSE IF menu='MSG' THEN
  DO
    SAY pen6'       ____________'def||CR
    SAY pen6'  ____/  'pen3'Messages'pen6'  \_____'def||CR
    SAY pen6' |                       |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp              'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'P'def']ost messages     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'R'def']ead messages     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch messages   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'E'def']mail (private)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP  'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'QUICK'def'] options     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'FL'def'] Friends List   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP  'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def'   ['pen3'^'def'] view BBS logs   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3')'def'] email report    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'='def'] level report    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3';'def'] change username 'pen6'|'def||CR;END
IF(level=99) THEN DO
    SAY pen6' |'def'   ['pen3'~'def'] online editor   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'@'def'] dos shell       'pen6'|'def||CR;END
    SAY pen6' |'def'   ['pen3'F'def']iles menu        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'.'def'] main menu       'pen6'|'def||CR
    SAY pen6' |_______________________|'def||CR
  END
ELSE IF menu='FILE' THEN
  DO
    SAY pen6'         _________'def||CR
    SAY pen6'  ______/  'pen3'Files'pen6'  \_______'def||CR
    SAY pen6' |                        |'def||CR
    SAY pen6' |'def'   ['pen3'A'def']lphabetic list    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'B'def']rowse filenotes   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'N'def']ew files list     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'L'def']ist by Library    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'F'def']ilelist archives  'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch files       'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'U'def']pload             'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'D'def']ownload           'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'T'def']ransfer protocol  'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'+'def'] Extra Devices    'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def'   ['pen3'K'def']ill a user        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'%'def'] edit filenote    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'('def'] file report      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3';'def'] change username  'pen6'|'def||CR;END
IF(level=99) THEN DO
    SAY pen6' |'def'   ['pen3'@'def'] dos shell        'pen6'|'def||CR;END
    SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'.'def'] main menu        'pen6'|'def||CR
    SAY pen6' |________________________|'def||CR
  END
ELSE IF menu='MAIN' THEN
  DO
    SAY pen6'       _____________'def||CR
    SAY pen6'  ____/  'pen3'Main Menu'pen6'  \_____'def||CR
    SAY pen6' |                        |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'I'def']nfomation         'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'J'def']ump to doorways   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'W'def']ho is here list   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch userlist    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'O'def']ther users info   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'#'def'] toggle colors    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'&'def'] user profiles    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'F'def']iles menu         'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
    SAY pen6' |________________________|'def||CR
  END
ELSE IF menu='ALL' THEN
  DO
    SAY pen6'     __________________________________________________________'def||CR
    SAY pen6'  __/   'pen3'Main Menu            File Menu          Message Menu 'pen6'  \__'def||CR
    SAY pen6' |                                                                |'def||CR
    SAY pen6' |'def' ['pen3'H'def']elp               ['pen3'A'def']lphabetical list  ['pen3'P'def']ost messages      'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'I'def']nformation        ['pen3'B'def']rowse filenotes   ['pen3'R'def']ead messages      'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'Z'def'] bbs statiZtics   ['pen3'L'def']ist by Library    ['pen3'E'def']mail (private)    'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'Y'def']our user data     ['pen3'N'def']ew files          ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'O'def']ther users info   ['pen3'F'def']ilelist archiver  ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'J'def']ump to doorways   ['pen3'+'def'] Extra Devices    ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'S'def']earch menu        ['pen3'D'def']ownload           ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'&'def'] user profiles    ['pen3'U'def']pload             ['pen3'#'def'] toggle colors    'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'V'def']iew user log      ['pen3'T'def']ransfer protocol  ['pen3','def'] hourly stats     'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'G'def']oodbye (logoff)   ['pen3'QUICK'def'] options      ['pen3'FL'def'] Friends List    'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def' ['pen3'K'def']ill a user        ['pen3'%'def'] edit filenote    ['pen3'='def'] level report     'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'^'def'] view BBS logs    ['pen3'('def'] file report      ['pen3';'def'] change username  'pen6'|'def||CR;END
IF(level=99) THEN
    SAY pen6' |'def' ['pen3'~'def'] online editor    ['pen3'@'def'] dos shell        ['pen3')'def'] email report     'pen6'|'def||CR
    SAY pen6' |________________________________________________________________|'def||CR
  END
QUEUE CR  /* clears any un-CRed input in the queue */
RETURN


help:
ARG helppath .
SAY CR
SAY 'For more detailed help, use ['pen3'I'def']nformation commmand to read BBBBS.COMMANDS.'CR
IF helppath='MAIN' THEN
  SAY 'Commands available from the' pen3||menu||def 'menu:'CR
frontend=bbspath'BBS_HELP/'helppath
backend='.USER'
IF level=0 THEN backend='.NEW'
ELSE IF level=99 THEN backend='.SUPER'
ELSE IF level>sysoplevel THEN backend='.SYSOP'
CALL showtext(frontend||backend 1)
RETURN


waiting:
CALL checktime()
IF waitchar='Q' THEN
  DO
    waitchar=''
    RETURN
  END
waitchar=''
IF nonstop=1 THEN RETURN
OPTIONS PROMPT pen3'                          RETURN=Continue 'def
PULL waitchar
CALL cleanline(1)
CALL checkdcd()
RETURN


waiting2:
CALL checktime()
IF nonstop=1 THEN RETURN 0
waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
IF waitchar='N' THEN
  DO
    nonstop=1
    SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def||CR
    SAY CR
    CALL DELAY(99)
    waitchar=''
  END
CALL cleanline(1)
CALL checkdcd()
IF waitchar='Q' THEN RETURN 1
RETURN 0


busywait:
ARG bii bi bt
IF bii>4 & bi//(10*bii)=0 THEN CALL checkdcd()
IF bbsprefs.21=0 THEN RETURN
IF bi<1 THEN
  DO
    CALL WRITECH(STDOUT,'080808'x)
    IF ni<1 & i>999998 & wi>999998 THEN SAY CR
    RETURN
  END
IF bi=1 THEN CALL WRITECH(STDOUT,'   ')
IF bi//(bii%2)~=0 THEN RETURN
b=bi//bii
IF b=0 | b=bii%2 THEN
  DO
    tp=RIGHT((bi*100)%bt,2)'%'
    CALL WRITECH(STDOUT,'080808'x||tp)
  END
RETURN


cleanline:
ARG lflag .
IF nonstop=0 & clr~='' THEN
  DO
    Send clr
    RETURN
  END
cline=lineup||LEFT(' ',78)
IF lflag=1 THEN cline=cline||lineup
SAY cline||CR
RETURN


getinput:
PARSE ARG upflag' 'oneflag' 'pline
CALL checkdcd()
OPTIONS PROMPT pline
PARSE PULL inarg
inarg=STRIP(inarg)
IF upflag THEN inarg=UPPER(inarg)
IF oneflag THEN inarg=LEFT(inarg,1)
inarg=cleanstring(0':'inarg)
RETURN inarg


docity:
PARSE ARG citi
citi=TRANSLATE(citi,'          ','+-.,*/()<>')
DO i=WORDS(citi) TO 1 BY -1
  IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
  IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
END
citi=SPACE(citi,1)
RETURN STRIP(citi)


postuser:
IF bbsprefs.12~=1 | ~SHOW('P','BBSPOST') THEN RETURN
ARG upflag .
IF upflag=6 THEN ptext='Logoff:' DATE() TIME('C')'  'name city
ELSE IF upflag=7 THEN ptext=name'  is a NEW USER!'
ELSE ptext='LogOn:' logontime'  'name city'  Last On:' DATE(,lastondate,'I')
ptext=CENTER(ptext,74)
CALL SETCLIP('BBSPOST1',ptext)
age='?'
IF UPPER(WORD(data.12,3))='BIRTHDAY:' THEN
  DO
    IF DATATYPE(WORD(data.12,4),'W') THEN
      DO
        age=LEFT(DATE('S'),4)-LEFT(WORD(data.12,4),4)
        IF SUBSTR(DATE('S'),5,2)<SUBSTR(WORD(data.12,4),5,2) THEN age=age-1
      END
  END
IF age='?' & WORD(data.12,4)~='' THEN age=WORD(data.12,4)
ptext=CENTER('Baud:' bps'   Age:' age'   Usage:' data.19,74)
CALL SETCLIP('BBSPOST2',ptext)
ptext2=''
ptext1=data.1'   '
IF DATATYPE(WORD(data.12,1),'W') THEN
  ptext2=ptext2'   First On:' DATE(,WORD(data.12,1),'S')
n=74-LENGTH(ptext1)-LENGTH(ptext2)
ptext2=ptext1||STRIP(LEFT(data.9,n))||ptext2
ptext2=CENTER(ptext2,74)
CALL SETCLIP('BBSPOST3',ptext2)
ulb=WORD(data.14,3)
IF ~DATATYPE(ulb,'W') | ulb=0 THEN ulb=1
dlb=WORD(data.15,3)
IF ~DATATYPE(dlb,'W') THEN dlb=0
ptext='Level: 'level'   dl/ul:' comma(TRUNC(dlb/ulb+.005,2))
IF upflag=0 THEN ptext=ptext
IF upflag=1 THEN ptext=ptext'   Cmd:' opt arg
IF upflag=2 THEN ptext=ptext'   MSG:' msg.msgdir
IF upflag=3 THEN ptext=ptext'   Email'
IF upflag=4 THEN ptext=ptext'   ul:' plaindir'/'arg
IF upflag=5 THEN ptext=ptext'   dl:' plaindir'/'arg
IF upflag=6 THEN ptext=ptext'   Elapsed:'elapsed' '
CALL SETCLIP('BBSPOST4',CENTER(ptext,74))
ADDRESS BBSPOST 'UPDATE'
ptext=''
IF EXISTS(bbspath'Email/'sysop'/NEW_FILES') THEN ptext='NEW_FILES !'
IF EXISTS(bbspath'Lists/CBV_USERS') THEN ptext=ptext 'CBV_USERS !'
IF EXISTS(bbspath'Lists/NEW_USERS') THEN ptext=ptext 'NEW_USERS !'
IF chatrequest=1 THEN ptext=ptext 'CHAT REQUEST !'
ptext=STRIP(ptext GETCLIP('BBS_ERROR'))
CALL SETCLIP('BBS_ERROR')
IF ptext='' THEN ptext=' '
ELSE ptext=CENTER('!' ptext,74)
IF ptext~=GETCLIP('BBSPOST5') THEN
  DO
    CALL SETCLIP('BBSPOST5',ptext)
    ADDRESS BBSPOST 'UPDATE'
  END
RETURN


postfour:
PARSE ARG parg
IF bbsprefs.12~=1 | ~SHOW('P','BBSPOST') THEN RETURN
ptext='Level: 'level'   dl/ul:' comma(TRUNC(dlb/ulb+.005,2))
CALL SETCLIP('BBSPOST4',CENTER(ptext'   'parg,74))
ADDRESS 'BBSPOST' 'UPDATE'
RETURN


whodat:
MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
RETURN


showtime:
mins=TIME('E')%60
secs=TRUNC(TIME('E')//60)+1
IF secs>59 THEN secs=59
IF secs<10 THEN secs='0'secs
line=' Time:  Used' mins':'secs
mins=(maxtime-TIME('E'))%60
secs=TRUNC((maxtime-TIME('E'))//60)
IF secs<10 THEN secs='0'secs
line=line'   Remaining' mins':'secs
SAY line||CR

checktime:
IF TIME('E')>maxtime THEN
  DO
    SAY 'Sorry,' name 'your time has expired.'CR
    CALL send2log('*** Time Expired ***')
    SIGNAL LOGOUT2
  END
IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
CALL whodat()
CALL checkdcd()
RETURN


setdir:
PARSE ARG tempdir
CALL PRAGMA('D',STRIP(tempdir))
directory=PRAGMA('D')
Data directory
slash=LASTPOS('/',directory)
IF slash=0 THEN slash=LASTPOS(':',directory)
plaindir=directory
IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
RETURN


config:
arg='s:CONFIG.BBS'
IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
IF readlines(arg 1) THEN
  DO
    SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR
    SIGNAL DONE2
  END
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
CALL SETCLIP('BBS_bbsname',bbsname)
sysop=WORD(lynes.2,1)
compos=POS('/*',lynes.3)
IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
exclusion=STRIP(lynes.3)
bbsdevice=WORD(lynes.4,1)
sysoplevel=WORD(lynes.5,1)
bbspath=WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
  DO
    SAY bbspath 'does not exist!'CR
    SIGNAL DONE2
  END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
CALL SETCLIP('BBS_path',bbspath)
msgpath=WORD(lynes.7,1)
IF ~EXISTS(msgpath) THEN
  DO
    SAY msgpath 'does not exist!'CR
    SIGNAL DONE2
  END
testchar=RIGHT(msgpath,1)
IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
CALL SETCLIP('BBS_msgpath',msgpath)
msgpath=msgpath'MSG'
libpath=WORD(lynes.8,1)
IF ~EXISTS(libpath) THEN
  DO
    SAY libpath 'does not exist!'CR
    SIGNAL DONE2
  END
testchar=RIGHT(libpath,1)
IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'
CALL SETCLIP('BBS_libpath',libpath)
extdevs=''
DO i=1 TO WORDS(lynes.10)
  test=WORD(lynes.10,i)
  IF POS(':',test)=0 THEN ITERATE i
  IF LEFT(test,2)='/*' THEN LEAVE i
  extdevs=STRIP(extdevs test)
END
SYSTEM_MSG_LIMIT=WORD(lynes.11,1)
SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
maxidle=WORD(lynes.13,1)
maxtime=WORD(lynes.14,1)
maxbps=WORD(lynes.15,1)
IF ~DATATYPE(maxbps,'W') THEN maxbps=2400
CALL SETCLIP('BBS_baud',maxbps)
DO i=16 TO 41
  j=i-15
  bbsprefs.j=STRIP(WORD(lynes.i,1))
END
spellpath=WORD(lynes.9,1)
IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  DO
    SAY spellpath 'does not exist!'CR
    bbsprefs.5=0
  END
IF bbsprefs.10 THEN scratch=bbspath'Scratch'
ELSE scratch='RAM:Scratch'
CALL MAKEDIR(scratch)
IF bbsprefs.12=1 THEN
  IF ~SHOW('P','BBSPOST') THEN ADDRESS AREXX bbsPOST.baud
IF ~DATATYPE(bbsprefs.16,'W') THEN bbsprefs.16=3
extension=WORD(lynes.32,1)
arccom=lynes.33
compos=POS('/*',lynes.33)
IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
arccom=STRIP(lynes.33)
IF LEFT(extension,1)~='.' THEN
  DO
    extension='.lzh'
    arccom='lharc -m m'
  END
lpost=WORD(lynes.34,1)
IF ~DATATYPE(lpost,'W') THEN lpost=3
rpost=WORD(lynes.35,1)
IF ~DATATYPE(rpost,'W') THEN rpost=11
IF SHOW('P','BBSPOST') THEN ADDRESS 'BBSPOST' 'CONFIG' lpost rpost
compos=POS('/*',lynes.42)
IF compos>0 THEN lynes.42=LEFT(lynes.42,compos-1)
bbsprefs.27=STRIP(lynes.42)
real=1
IF WORD(lynes.43,1)=0 THEN real=0
RETURN


readlogs:
t=getinput(1 1 'Read [D]aily, [N]umbers, or [Q]uick log? (dnq) > ')
IF t='' THEN RETURN
IF t='D' THEN
  DO
    arg=getinput(1 0 '['pen3'RETURN'def']=TODAY, or enter Log Date ('pen3||DATE('S')||def') > ')
    IF arg='' THEN arg=DATE('S')
    arg=bbspath'Logs/log.'arg
  END
ELSE IF t='N' THEN arg=bbspath'logs/QUICK.log'
ELSE IF t='Q' THEN arg=bbspath'logs/Numbers.log'
ELSE RETURN
CALL showtext(arg 1)
RETURN


loadcourtesy:
IF courtesyflag=0 & courtesy='' & EXISTS(bbspath'Lists/Courtesy') THEN
  DO
    IF readopen(bbspath'Lists/Courtesy') THEN
      DO
        SAY 'Checking Courtesy List...'CR
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK
          line=cleanstring(1':'line)
          courtesy=courtesy line
        END
        CALL CLOSE(f)
        MSG ''
        MSG pen3'Courtesy List:'def
        MSG courtesy
      END
  END
RETURN


fileheader:
SAY 'Filename          Bytes File# Library         KeyWords'CR
SAY pen3||LEFT('=',77,'=')||def||CR
RETURN


showalpha:
libtext=0
IF DATATYPE(arg,'W') THEN
  DO
    dirnum=arg
    arg=''
    test='Y'
    IF chdir2()>0 THEN
      DO
        libtext=1
        RETURN
      END
  END
ELSE
  DO
    test=getinput(1 1 'Show one library only? (Ny) > ')
    IF test='Y' THEN
      DO
        IF chdir()>0 THEN
          DO
            libtext=1
            RETURN
          END
      END
  END

showalpha2:
libtext=1
IF test='Y' THEN
  DO
    CALL postfour('AlphaList:' plaindir)
    lfile=libpath||plaindir'/.'STRIP(LEFT(plaindir,15))
    IF EXISTS(lfile) THEN
      DO
        CALL showtext(lfile 1)
        nonstop=0
        RETURN
      END
    filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
  END
ELSE filecount=files.0
SAY '  'filecount 'files.'CR
CALL fileheader()
count=0
DO wi=1 TO alpha.0
  CALL busywait(60 wi alpha.0)
  IF test='Y' THEN
    DO
      IF count>=filecount THEN LEAVE wi
      IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.wi,5),12)) THEN
        ITERATE wi
    END
  jj=WORD(alpha.wi,4)
  IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN
    ITERATE wi
  CALL busywait(4 0)
  SAY alpha.wi||CR
  count=count+1
  IF (count+2)//linesperpage=0 & wi<alpha.0 THEN
    IF waiting2() THEN
      DO
        CALL busywait(4 1)
        LEAVE wi
      END
  CALL busywait(4 1)
END
CALL busywait(4 0)
nonstop=0
IF waitchar~='Q' THEN CALL waiting()
RETURN


otheruser:
SAY lm
CALL bbsOther.rexx(maxtime-TRUNC(TIME('E')) name sysoplevel real bbspath bbsname)
RETURN


changename:
ARG cname
IF level<=sysoplevel THEN RETURN
IF cname='' THEN cname=getinput(1 0 'Current Username (include underscore): ')
IF readlines(bbspath'Users/'cname 1)>0 THEN RETURN
IF WORD(lynes.20,1)>level THEN RETURN
CALL SETCLIP('BBS_oldname',cname)
CALL ChangeUserName.rexx()
ncname=GETCLIP('BBS_newname')
IF name=cname THEN name=ncname
IF GETCLIP('BBS_oldname')='' THEN
  CALL send2log('Name change from' cname 'to' ncname)
sortuserflag=1
CALL SETCLIP('BBS_oldname')
CALL SETCLIP('BBS_newname')
RETURN ncname


levelreport:
SAY lm
CALL bbsNewUsers.rexx(name level colorflag maxtime-TRUNC(TIME('E')))
RETURN


filereport:
SAY 'Searching for mismatches between files and filenotes...'CR
DO i=1 TO sysoplevel+1
  IF dirs.i='' THEN ITERATE
  SAY dirs.i'                               'lineup||CR
  rfiles=SHOWDIR(libpath||dirs.i)
  rnotes=SHOWDIR(bbspath'FileNotes/'dirs.i)
  IF WORDS(rfiles)~=WORDS(rnotes) THEN
    DO
      line='Compare files & filenotes in'pen3 dirs.i||def'. '
      DO j=1 TO WORDS(rfiles)
        IF FIND(UPPER(rnotes),UPPER(WORD(rfiles,j)))=0 THEN
          line=line WORD(rfiles,j)
      END
      SAY line||CR
    END
END
Send '^G'
CALL waiting()
RETURN


mailreport:
SAY 'Checking ALL pending Email...'CR
SAY pen3' - Use CTRL-E to Exit -'def||CR
SAY CR
mailrep=SHOWDIR(bbspath'Email','D')
mailfil=SHOWDIR(bbspath'EmailFiles','D')
lastemail=WORD(data.17,3)
IF ~DATATYPE(lastemail,'W') THEN lastemail=0
IF lastemail=countcheck('Numbers/LastMail' 0) THEN
  DO
    DROP mailrep. mailfil.
    RETURN
  END
mailynes.=''
mk=0
DO mi=1 TO WORDS(mailrep)
  muser=WORD(mailrep,mi)
  IF muser=sysop | muser=name THEN ITERATE mi
  mlist=SHOWDIR(bbspath'Email/'muser)
  IF WORDS(mlist)>0 THEN SAY lineup||RIGHT(muser,40)||CR
  DO mj=1 TO WORDS(mlist)
    fuser=WORD(mlist,mj)
    IF POS(sysop,fuser)>0 THEN ITERATE mj
    IF logonflag=0 THEN
      DO
        mk=mk+1
        mailynes.mk=pen3||LEFT(muser,20) 'from'def LEFT(fuser,20) DATE(,WORD(STATEF(bbspath'Email/'muser'/'fuser),5),'I')
      END
    IF POS(sysop,fuser)=0 & POS(name,fuser)=0 THEN
      DO
        testnum=RIGHT(fuser,LENGTH(fuser)-LASTPOS('.',fuser))
        IF testnum>emailnum THEN emailnum=testnum
        IF testnum>lastemail THEN
          DO
            CALL showtext(bbspath'Email/'muser'/'fuser 1)
            SAY CR
            SAY CR
            IF waitchar='Q' THEN LEAVE mi
          END
      END
  END
  IF logonflag=0 & FIND(mailfil,muser)>0 THEN
    DO
      efilelist=SHOWDIR(bbspath'EmailFiles/'muser)
      IF WORDS(efilelist)>0 THEN
        DO
          mk=mk+1
          mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist
        END
    END
END
data.17=WORD(data.17,1) WORD(data.17,2) countcheck('Numbers/LastMail' 0)
IF mk>0 THEN
  DO
    lynes.0=mk
    DO mi=1 TO mk
      lynes.mi=mailynes.mi
    END
    CALL seelines(1)
    nonstop=0
    CALL waiting()
  END
ELSE SAY 'No unseen Email pending.'CR
DROP mailrep. mailfil. mailynes. mlist
RETURN


jump2rexx:
arg=bbspath'BBS_TEXT/REXXDOORS'
IF EXISTS(arg) THEN CALL showtext(arg 0)
CALL sound('JUMP')
SAY lm
CALL bbsDoors.rexx(TRUNC(maxtime-TIME('E'))-42 name password)
x=GETCLIP('BBS_maxtime')
CALL SETCLIP('BBS_maxtime')
IF DATATYPE(x,'W') THEN maxtime=x+TIME('E')
x=GETCLIP('BBS_winnings')
IF DATATYPE(x,'W') THEN winnings=x
CALL SETCLIP('BBS_winnings')
RETURN


sortlibraries:
SAY 'Sorting Libraries...'CR
count=0
sdirs.=''
DO i=1 TO level
  IF dirs.i='' THEN ITERATE i
  count=count+1
  sdirs.count=dirs.i i
END
sdirs.0=count
IF count>0 THEN CALL QSort(1,count,sdirs)
count=0
libs.=''
DO i=1 TO sdirs.0
  tempnum=WORD(sdirs.i,2)
  tempdir=WORD(sdirs.i,1)
  IF FIND(data.21,UPPER(tempdir))=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'. 'LEFT(tempdir,14)
      count=count+1
      libs.count=string
    END
END
libs.0=count%4
IF (count//4)>0 THEN libs.0=libs.0+1
DO i=1 TO libs.0
  DO j=1 TO 3
    k=i+j*libs.0
    IF k<=count THEN libs.i=libs.i||libs.k
  END
END
DROP sdirs.
RETURN


sortconferences:
SAY 'Sorting Conferences...'CR
count=0
smsg.=''
DO i=1 TO level
  IF msg.i='' THEN ITERATE i
  count=count+1
  smsg.count=msg.i i
END
smsg.0=count
IF count>0 THEN CALL QSort(1,count,smsg)
count=0
msgs.=''
DO i=1 TO smsg.0
  tempnum=WORD(smsg.i,2)
  tempdir=WORD(smsg.i,1)
  IF FIND(data.21,tempnum)=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'.'
      IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
        string=string LEFT(tempdir,20)
      ELSE string=string pen2'-OFF-'def LEFT(tempdir,14)
      count=count+1
      msgs.count=string
    END
END
msgs.0=count%3
IF (count//3)>0 THEN msgs.0=msgs.0+1
DO i=1 TO msgs.0
  DO j=1 TO 2
    k=i+j*msgs.0
    IF k<=count THEN msgs.i=msgs.i msgs.k
  END
END
DROP smsg.
RETURN


readmessages:
SAY lm
CALL SETCLIP('BBSMSG_ARG',colorflag arg)
CALL bbsMsg.rexx(maxtime-TRUNC(TIME('E')) name password)
CALL loaddata()
CALL checkemail()
RETURN


showmarked:
ARG ff .
IF WORDS(data.24)<1 THEN RETURN
fline='These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:'
IF ff THEN
  DO
    SAY CR
    SAY pen6||fline||def||CR
  END
tempkk=data.24
DO i=1 TO WORDS(tempkk)
  tempk=WORD(tempkk,i)
  PARSE VAR tempk kdir'/'kmsg
  line=RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference'
  IF EXISTS(msgpath||tempk) THEN
    DO
      IF ff THEN SAY line'.'CR
      ELSE fline=fline'0A'x||line'.'
    END
  ELSE
    DO
      line=line 'is missing.'
      IF ff THEN SAY line||CR
      ELSE fline=fline'0A'x||line
      mkw=FIND(data.24,tempk)
      data.24=STRIP(DELWORD(data.24,mkw,1))
      CALL savedata(0)
    END
END
IF ff THEN
  DO
    CALL waiting()
    SAY CR
  END
ELSE
  DO
    IF writeopen(bbspath'EmailFiles/'name'/Marked')=0 THEN RETURN
    CALL WRITELN(f,fline)
    CALL CLOSE(f)
  END
RETURN


readmail:
ARG fromenu .
replysubj=''
IF fromenu THEN SAY lm
ELSE arg=''
CALL SETCLIP('BBSMAIL_ARG',fromenu arg)
allargs=bbsMail.rexx(maxtime-TRUNC(TIME('E')) name password)
CALL loaddata()
IF DATATYPE(allargs,'N') THEN allargs=''
IF allargs~='' THEN
  DO
    CALL dload2()
    CALL readmail(0)
  END
CALL checkemail()
RETURN


checkemail:
x=GETCLIP('BBS_email')
CALL SETCLIP('BBS_email')
If DATATYPE(x,'W') THEN
  IF emailonline>-1 THEN emailonline=emailonline+x
RETURN


countcheck:
PARSE ARG fname' 'cknum .
fname=bbspath||fname
IF ~EXISTS(fname) THEN
  DO
    IF cknum=0 THEN RETURN 0
    IF ~writeopen(fname) THEN RETURN 0
    CALL WRITELN(f,cknum)
    CALL CLOSE(f)
    RETURN cknum
  END
IF ~readopen(fname) THEN
  DO
    CALL DELAY(99)
    IF ~readopen(fname) THEN RETURN cknum
  END
retval=STRIP(READLN(f))
CALL CLOSE(f)
IF ~DATATYPE(retval,'W') THEN retval=0
IF ~DATATYPE(cknum,'W') THEN cknum=0
IF retval<cknum THEN
  DO
    IF writeopen(fname) THEN
      DO
        CALL WRITELN(f,cknum)
        CALL CLOSE(f)
        RETURN cknum
      END
  END
RETURN retval


sysED:
IF level<99 THEN RETURN
arg=getinput(0 0 'Textfile To Edit: ')
IF arg='' THEN RETURN
SAY lm
CALL bbsEd.rexx(1 arg name TRUNC(maxtime-TIME('E'))-28)
CALL checkfilechanges()
RETURN


editor:
PARSE ARG edarg
SAY lm
IF bbsWrite.rexx(edarg)=0 THEN RETURN
IF WORD(edarg,3)='MAIL' THEN
  DO
    IF emailonline>=0 THEN emailonline=emailonline+1
  END
ELSE
  DO
    grand=grand+1
    IF ~DATATYPE(msg.msgdir.0,'W') THEN msg.msgdir.0=1
    ELSE msg.msgdir.0=msg.msgdir.0+1
  END
CALL loaddata()
RETURN


edinfo:
PARSE ARG t1,t2,t3
IF level<sysoplevel THEN RETURN 0
IF getinput(1 1 'Edit the'pen3 t2 def||t3 'info file? (Ny) > ')='Y' THEN
  DO
    IF ~EXISTS(t) THEN
      DO
        IF writeopen(t1)~=0 THEN
          DO
            CALL WRITELN(f,TRIM(CENTER('***'pen3 t2 def||t3 '***',75)))
            CALL WRITELN(f,LEFT('',75,'='))
            CALL CLOSE(f)
            CALL DELAY(28)
          END
      END
    CALL bbsEd.rexx(1 t1 name TRUNC(maxtime-TIME('E'))-28)
    RETURN 1
  END
RETURN 0


shell:
SAY CR
olddir=PRAGMA('D')
DO WHILE(UPPER(opt)~='EXIT')
  SAY bak2||TIME('C')||def PRAGMA('D')||CR
  OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def
  PARSE PULL opt' 'arg
  CALL checkdcd()
  IF(UPPER(opt)='CD') THEN CALL setdir(arg)
  ELSE IF EXISTS(opt)~=0 THEN
    DO
      IF LEFT(STATEF(opt),3)='DIR' THEN CALL setdir(opt)
    END
  ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN
    ADDRESS COMMAND opt '<* >*' arg
END
CALL PRAGMA('D',olddir)
RETURN


yell:
chatrequest=1
IF excuses.1='' THEN
  DO
    IF readopen(bbspath'Lists/Excuses') THEN
      DO
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK
          excuses.i=line
        END
        excuses.0=i-1
        CALL CLOSE(f)
      END
  END
j=TIME('S')//excuses.0+1
SAY CR
SAY 'Sorry, your SysOp,' sysop','CR
IF excuses.j~='' THEN SAY excuses.j||CR
ELSE SAY 'is not available, please leave a ['pen3'C'def']omment.'CR
SAY CR
IF bbsprefs.13 THEN RETURN
SAY 'I''m yelling anyway...'CR
SAY 'If nobody answers, please try again later or leave a ['pen3'C'def']omment'CR
CALL sound('YELL')
ADDRESS AREXX bbsSpeak.rexx 'CHAT' name bbspath saypath
RETURN


/* online change to member. Sysop triggered by BumpMember.baud */
/* user triggered by Call Back Verification CBV: */
validate:
ARG varg .
IF readopen(bbspath'BBS_TEXT/'varg) THEN
  DO
    SAY CR
    SAY 'You are being validated.  Please wait...'CR
    SAY CR
    DO lvi=1 TO 22
      line=READLN(f)
      IF lvi=11 THEN data.11=line
      IF lvi=17 THEN data.17=WORD(line,1) WORD(data.17,2) WORD(data.17,3)
      IF lvi=20 THEN data.20=line
      IF lvi=21 THEN data.21=line
    END
    data.22=line
    CALL CLOSE(f)
    CALL setdata()
    CALL sortlibraries()
    CALL sortconferences()
    CALL setmsgs()
    SAY CR
    CALL logonstats()
    CALL savedata(0)
    IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN
      DO
        CALL MAKEDIR(bbspath'EMail/'name)
        lastwrit=countcheck('Numbers/LastMail' 0)+1
        IF lastwrit>1 THEN CALL countcheck('Numbers/LastMail' lastwrit)
        lynes.=''
        lynes.1=' Mail:' lastwrit
        lynes.2=' From:' sysop
        lynes.3='   To:' name
        lynes.4=' Subj: Welcome to' bbsname
        lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
        lynes.6=LEFT('',74,'=')
        CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
        CALL savelines(bbspath'EMail/'name'/'sysop'.'lastwrit)
        SAY 'You have welcoming EMail.'CR
      END
    CALL waiting()
    IF bbsprefs.22=2 & varg='DEF.CBV' THEN
      DO
        SAY CR
        SAY pen3||name def'is now a fully valadated member of'pen3 bbsname||def||CR
        SAY 'All the features of the BBS will be available on your next call.'CR
        SAY CR
        CALL waiting()
        SIGNAL LOGOUT2
      END
    SIGNAL RESTART
  END
ELSE
  DO
    SAY 'Sorry. Auto-validation is disabled.'CR
    temp=' ***' sysop'!  You need a default file in BBS_TEXT!  (' varg ') *** '
    MSG bak2||temp||def||CR
    CALL Send2log(temp)
  END
RETURN


/* online time change. Sysop triggered by BumpTime.baud */
uptime:
mins=GETCLIP('BBS_minutes')
IF DATATYPE(mins,'N') THEN
  DO
    IF (mins*60)>maxtime THEN
      SAY name', this session''s time has been increased to' mins 'minutes.'CR
    ELSE MSG '*** User has not been told that his time has decreased.'
    CALL SETCLIP('BBS_minutes')
    maxtime=mins*60
  END
RETURN


/* online level change. Sysop triggered by BumpLevels.baud */
uplevel:
levl=GETCLIP('BBS_level')
IF DATATYPE(levl,'W') THEN
  DO
    IF levl>data.20 THEN
      SAY name', your level has been changed from' data.20 'to' levl'.'CR
    ELSE MSG '*** User has not been told his level has been reduced.'
    data.20=levl
    CALL setdata()
    IF menu='NEW' THEN menu='ALL'
    CALL sortlibraries()
    CALL sortconferences()
  END
RETURN


/* online ratio change. Sysop triggered by BumpLevels.baud */
upratio:
rats=GETCLIP('BBS_ratio')
IF DATATYPE(rats,'W') THEN
  DO
    SAY name', your upload:download ratio has been changed to 1:'rats'.'CR
    data.17=rats'  'WORD(data.17,2)'  'WORD(data.17,3)
    CALL SETCLIP('BBS_ratio')
  END
RETURN


bytes2user:
PARSE ARG indx bytes .
tfiles=WORD(data.indx,1)
tbytes=WORD(data.indx,3)
IF ~DATATYPE(tfiles,'W') THEN tfiles=0
IF ~DATATYPE(tbytes,'W') THEN tbytes=0
tbytes=tbytes+bytes
tfiles=tfiles+1
IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.'
ELSE data.indx='1 file' bytes 'bytes.'
data.indx=data.indx DATE()
CALL savedata(0)
RETURN


bbsspace:
ARG tabspace .
ADDRESS COMMAND 'C:info >'scratch'/infout' bbsdevice
ok=OPEN(f,scratch'/infout','R')
IF ok=0 THEN RETURN 20
line=READLN(f)
line=READLN(f)
line=READLN(f)
line=READLN(f)
CALL CLOSE(f)
IF tabspace<14 THEN SAY CR
bbsk=WORD(line,4)
IF ~DATATYPE(bbsk,'N') THEN
  DO
    line=bbsdevice 'is not an info compatible device!'
    CALL send2log(line)
    SAY pen3||line||def||CR
    bbsk=0
    RETURN
  END
bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
IF bbsk<1 THEN bbsk=0
SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR
RETURN


comma: PROCEDURE
ARG num .
t=''
x=POS('.',num)
IF x>0 THEN t=SUBSTR(num,x)
num=num%1
dgt=LENGTH(num)
numtext=''
IF dgt>3 THEN numtext=','RIGHT(num,3)
IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
IF dgt>12 THEN
  DO
    numtext=','LEFT(RIGHT(num,12),3)||numtext
    numtext=LEFT(num,dgt-12)||numtext
  END
ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
ELSE numtext=num
RETURN numtext||t


is_here:
ARG newname
CALL WRITECH(STDOUT,'Checking filelist')
DO wi=1 TO 99
  IF wi//3=0 THEN CALL WRITECH(STDOUT,'.')
  IF dirs.wi='' THEN ITERATE wi
  IF ~EXISTS(bbspath'FileNotes/'dirs.wi'/'newname) THEN ITERATE wi
  line=pen3'*** File' newname 'already exists here'
  IF wi<=level THEN line=line 'in the' dirs.wi 'library'
  line=line'.'def
  SAY CR
  SAY line||CR
  SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'CR
  CALL waiting()
  RETURN 1
END
SAY CR
CALL cleanline(1)
RETURN 0


uload:
ARG frommenu
IF frommenu THEN
  DO
    SAY CR
    SAY pen3'PLEASE!'def 'Only upload 1 (one) archive at a time. NO BATCH UPLOADING! Thanks.'CR
  END
CALL bbsspace(12)
SAY CR
IF bbsk<1 THEN
  DO
    line='Upload area is full!'
    CALL send2log(line)
    SAY pen3||line||def||CR
    RETURN 1
  END
IF ~SHOW('P','BUILDALPHA') THEN CALL SETCLIP('BBS_UPLOAD')
IF frommenu & GETCLIP('BBS_UPLOAD')~='' THEN
  DO
    SAY pen3'Uploading is temporarily suspended while the filelists are rebuilding.'def
    CALL waiting()
    RETURN 1
  END
IF arg='' THEN arg=getinput(0 0 'Filename: ')  /* no filename given */
arg=cleanstring('0:'arg)
arg=COMPRESS(arg,' :/,;|#?*')  /* be sure no illegals here */
IF UPPER(arg)='RZ' | UPPER(LEFT(arg,4))='B000' THEN
  DO
    SAY CR
    SAY pen3'Error!'def arg 'is not allowed as a filename. Please try again.'CR
    CALL waiting()
    RETURN 1
  END
x=LASTPOS('/',arg)
IF x=0 THEN x=LASTPOS(':',arg)
IF x>0 THEN
  DO
    IF DATATYPE(SUBSTR(arg,x+1),'W') THEN
      DO
        SAY CR
        SAY pen3'Error!'def 'Whole numbers are not allowed as filenames!'CR
        CALL waiting()
        RETURN 1
      END
  END
tempnum=LENGTH(arg)-16
DO WHILE tempnum>0 & POS('EMAILFILES',UPPER(PRAGMA('D')))=0
  temp='          'pen3||arg def'is'pen3 tempnum||def
  IF tempnum=1 THEN temp=temp 'character'
  ELSE temp=temp 'characters'
  temp=temp 'too long for a filename.'
  SAY temp||CR
  arg=getinput(0 0 'Filename: ')
  arg=cleanstring('0:'arg)
  arg=COMPRESS(arg,' :/,;|#?*()+[]"{}')
  tempnum=LENGTH(arg)-16
END
IF arg='' THEN RETURN 1
IF frommenu THEN
  DO
    IF is_here(arg) THEN RETURN 1
    IF wi=999999 THEN RETURN 1
    IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(libpath'Sysops')
    ELSE
      DO loop=1
        SAY 'Please select an appropriate library for -' pen3||arg def'-'CR
        temp=chdir()
        IF temp=0 THEN LEAVE loop
        IF temp=2 THEN RETURN 1
      END
  END
checkproto='T'
targ=arg
DO WHILE checkproto='T'
  arg=''
  SAY CR
  SAY 'Library:'pen3 plaindir def'  Filename:'pen3 targ def'  Protocol:'pen3 protocol||def||CR
  pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
  pline=pline '['pen3'U'def']pload (qtU) > '
  checkproto=getinput(1 1 pline)
  IF checkproto='Q' THEN RETURN 1
  IF checkproto='T' THEN CALL chpro()
END
arg=targ
CALL postuser(4)
CALL sound('UPLOAD')
uploadtime=TIME('E')
SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
CALL whodat()
uldlflag=1
DownLoad arg
IF RC>0 THEN RETURN 2
IF bbsXferStats.baud(14 arg colorflag protocol) THEN RETURN 2
rbytes=WORD(STATEF(arg),2)
IF rbytes<1 THEN
  DO
    CALL DELETE(arg)
    RETURN 2
  END
temp=''
DO WHILE temp~='N' & temp~='Y'
  temp=getinput(1 1 'Received' rbytes 'bytes. Was your upload successful? (ny) > ')
END
IF temp='N' THEN RETURN 2
IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
  DO
    SAY CR
    SAY pen3'***'def arg pen3'failed archive check!'def||CR
    SAY CR
    temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
    IF temp~='Y' THEN
      DO
        CALL DELETE(arg)
        SAY CR
        RETURN 2
      END
  END
CALL bytes2user(14 rbytes)
ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg
IF bbsprefs.9 & name~=sysop THEN
  DO
    newufile=bbspath'EMail/'sysop'/NEW_FILES'
    IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
    ELSE
      DO
        ok=OPEN(f,newufile,'W')
        IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***')
      END
    IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg'  'DATE() TIME())
    CALL CLOSE(f)
  END
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN
  DO
    uldlflag=0
    RETURN 0
  END
DO ui=sysoplevel+2 TO 100
  IF UPPER(dirs.ui)=UPPER(plaindir) THEN RETURN 0     /* no filenotes */
END
IF frommenu THEN
  DO
    uploadtime=TIME('E')-uploadtime
    IF bbsprefs.11 THEN
      DO
        maxtime=maxtime+uploadtime
        line='This session''s time has been increased by'
        line=line TRUNC(uploadtime%60+.05,1)+1 'minutes.'
        SAY CR
        SAY line||CR
        SAY 'Your ratio of bytes uploaded to bytes downloaded is 1:'ratio()||CR
      END
    CALL sound('NEW_FILE')
    uldlflag=0
    DO WHILE editnote(arg)  /* INSIST on a filenote */
    END
    CALL DELETE(libpath||plaindir'/.'STRIP(LEFT(plaindir,15)))
    SAY pen3'Thank you for contributing to the' bbsname 'file libraries!'def||CR
  END
uldlflag=0
waitchar=''
RETURN 0


ratio:
upbytes=WORD(data.14,3)
IF ~DATATYPE(upbytes,'W') | upbytes<1 THEN upbytes=1
dnbytes=WORD(data.15,3)
IF ~DATATYPE(dnbytes,'W') | dnbytes<1 THEN dnbytes=1
RETURN TRUNC((dnbytes/upbytes)+.5)


findfiles:
PARSE ARG ffile .
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile
wi=0
IF DATATYPE(ffile,'W') THEN
  DO
    IF WORDS(files.ffile)<2 THEN RETURN 0
    dirtemp=WORD(files.ffile,1)
    IF finddirnum(dirtemp)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
      DO
        CALL illegal_access()
        RETURN 0
      END
    CALL setdir(libpath||dirtemp)
  END
ELSE IF EXISTS(ffile) THEN
  DO
    IF EXISTS(bbspath'FileNotes/'plaindir'/'ffile) THEN
      DO
        IF readopen(bbspath'FileNotes/'plaindir'/'ffile)~=0 THEN
          DO
            line=READLN(f)
            CALL CLOSE(f)
            ffile=WORD(line,2)
          END
      END
  END
ELSE IF EXISTS(bbspath'Information'ffile) THEN
  RETURN bbspath'Information/'ffile
ELSE
  DO
    nextfilenum=countcheck('Numbers/LastFile' 0)+1
    CALL busywait(4 1)
    DO ni=nextfilenum TO 0 BY -1
      IF ni<1 THEN
        DO
          CALL busywait(4 0)
          SAY CR
          SAY '***' files.0 'filenames scanned,'pen3 ffile def'is not on the filelist!'CR
          SAY CR
          RETURN 0
        END
      IF ni>1 THEN CALL busywait(60 ni nextfilenum)
      argtemp=WORD(files.ni,2)
      IF UPPER(argtemp)=UPPER(ffile) THEN
        DO
          dirtemp=WORD(files.ni,1)
          jj=files.ni.0
          IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
            DO
              CALL busywait(4 0)
              CALL illegal_access()
              RETURN 0
            END
          ffile=ni
          CALL setdir(libpath||dirtemp)
          LEAVE ni
        END
    END
    CALL busywait(4 0)
  END
IF wi=999999 THEN RETURN 0
ftemp=ffile
IF DATATYPE(ftemp,'W') THEN ftemp=WORD(files.ftemp,2)
IF ~EXISTS(ftemp) THEN
  DO
    finfo=STATEF(bbspath'FileNotes/'plaindir'/'ftemp)
    IF WORDS(finfo)>7 THEN ftemp=WORD(finfo,8)
    IF ~EXISTS(ftemp) THEN
      DO
        IF finfo='' THEN SAY '***'pen3 PRAGMA('D')'/'ftemp def'was not found!'CR
        ELSE
          DO
            SAY CR
            IF WORDS(finfo)<8 THEN ftemp=plaindir'/'ftemp
            SAY '***'pen3 ftemp def'is not currently available online.'CR
            SAY ' Would you like me to notify the sysop'CR
            SAY ' that you''d like to receive this file?'CR
            IF getinput(1 1 ' (Ny) > ')='Y' THEN
              DO
                enum=countcheck('Numbers/LastMail' 0)+1
                CALL countcheck('Numbers/LastMail' enum)
                IF writeopen(bbspath'email/'sysop'/'name'.'enum)=0 THEN RETURN
                CALL WRITELN(f,' Mail: 'enum )
                CALL WRITELN(f,' From: 'name)
                CALL WRITELN(f,'   To: 'sysop)
                CALL WRITELN(f,' Subj: File Request')
                CALL WRITELN(f,' Date: 'DATE()'  'TIME('C'))
                CALL WRITELN(f,'====================================================================')
                CALL WRITELN(f,' Mr. Sysop, I would like to have this file : ')
                CALL WRITELN(f,' 'ftemp)
                CALL WRITELN(f,' ')
                CALL CLOSE(f)
                SAY CR
                ADDRESS AREXX bbsSpeak.rexx 'FILE_REQUEST' name bbspath saypath
                SAY 'Your file request has been sent!'CR
                SAY 'The file should be in your Email soon.'CR
              END
            SAY CR
          END
        RETURN 0
      END
  END
RETURN ffile


illegal_access:
SAY CR
SAY '*** You are not authorized to access' ffile'!'CR
SAY '*** Send Email to' sysop 'to receive a higher level.'CR
SAY CR
IF DATATYPE(ffile,'W') THEN ffile=ffile WORD(files.ffile,2)
CALL send2log('Illegal Access Attempt!' ffile 'in' dirtemp)
RETURN


statuscheck:
PARSE ARG ffile
updownratio=WORD(data.17,1)
IF ~DATATYPE(updownratio,'N') THEN updownratio=100
updn=ratio()
dbytes=WORD(STATEF(ffile),2)
IF ~DATATYPE(dbytes,'W') THEN dbytes=1
IF ~DATATYPE(bps,'W') THEN bps=2400
needtime=dbytes%(bps%10)+10  /* plus 10 seconds for handshaking? */
SAY CR
SAY CR
CALL showtime()
SAY 'At least' TRUNC(needtime/60+.05,1) 'minutes needed to download' ffile 'at' bps 'baud.'CR
SAY 'After this transfer your upload:download ratio will be 1:'TRUNC((dbytes+dnbytes)/upbytes)||CR
IF level>(sysoplevel+1) THEN RETURN 0
IF (needtime+TIME('E'))>maxtime THEN
  DO
    SAY CR
    SAY 'Sorry, not enough time left in this session to download' dbytes 'bytes.'CR
    IF needtime>(WORD(data.11,1)*60) THEN
      SAY 'Leave email to the sysop to make other arrangements to receive this file.'CR
    SAY CR
    RETURN 1
  END
IF updownratio>0 & updn>updownratio THEN
  DO
    SAY CR
    line=pen3'       *** You must upload before you do any more downloading! ***'def
    SAY line||CR
    SAY '  Maintain a ratio of at least 1 byte uploaded for each' updownratio 'bytes downloaded.'CR
    IF bbsprefs.4 THEN RETURN 1
    SAY pen3'             - This requirement is temporarily suspended. -'def||CR
    SAY CR
  END
RETURN 0


ext_dload:
SAY CR
CALL checkdcd()
allargs=bbsExtDL.baud(name level TRUNC(maxtime-TIME('E')) linesperpage colorflag extdevs)
IF allargs='' | TRUNC(maxtime-TIME('E'))<30 THEN RETURN
CALL dload2()
RETURN


dload:
arg=STRIP(arg data.25)
data.25=''
curdir=PRAGMA('D')
OPTIONS PROMPT 'File numbers (and/or names): '
IF arg='' THEN PARSE PULL arg  /* no filename given */
IF arg='' THEN RETURN 0
allargs=TRANSLATE(arg,'     ',':/,;|')
tempargs=SPACE(allargs,1)
numchk=1
DO ui=1 TO WORDS(tempargs) WHILE STRIP(allargs)~=''
  arg=WORD(tempargs,ui)
  IF ~DATATYPE(arg,'W') THEN numchk=0
  wloc=WORDINDEX(allargs,FIND(allargs,arg))
  wi=0
  temp=findfiles(arg)
  IF wi=999999 THEN RETURN 0
  IF temp~=arg THEN
    DO
      allargs=DELWORD(allargs,FIND(allargs,arg),1)
      IF temp~=0 THEN allargs=INSERT(temp' ',allargs,wloc-1)
    END
END
IF numchk=0 THEN
  IF countcheck('Numbers/LastFile' 0)>500 THEN
    DO
      SAY LEFT('',20)||CR
      SAY bak2' BBBBS Tip:'def'  Next time try using fileNUMBERS instead of fileNAMES.'CR
      SAY '              The BBS is MUCH faster at locating files by number.'CR
    END

dload2:
curdir=PRAGMA('D')
allargs=STRIP(allargs data.25)
data.25=''
IF allargs='' THEN RETURN 0
sleepy='T'
DO WHILE sleepy='T'
  arg=''
  SAY LEFT('',20)||CR
  temp=WORD(allargs,1)
  IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2)
  test=''
  IF LENGTH(temp)>40 THEN
    DO
      test=temp
      temp=''
    END
  SAY 'Filename(s)'pen3 LEFT(temp,40) def'Protocol:'pen3 protocol||def||CR
  IF test~='' THEN SAY '           'pen3 test||def||CR
  DO di=2 TO WORDS(allargs)
    temp=WORD(allargs,di)
    IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2)
    SAY '           'pen3 temp||def||CR
  END
  pline='['pen3'A'def']uto-Logoff-after-transfer ['pen3'D'def']ownload'
  pline=pline '['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol (aDqt)'
  sleepy=getinput(1 1 pline '> ')
  IF sleepy='Q' THEN RETURN 0
  IF sleepy='A' THEN sleepy='LOGOFF'
  IF sleepy='T' THEN CALL chpro()
END
DO WHILE allargs~=''
  errorflag=0
  extdir=''
  arg=WORD(allargs,1)
  allargs=STRIP(DELWORD(allargs,1,1))
  IF DATATYPE(arg,'W') THEN
    DO
      CALL setdir(libpath||WORD(files.arg,1))
      arg=WORD(files.arg,2)
    END
  notename=bbspath'FileNotes/'plaindir'/'arg
  finfo=''
  IF ~EXISTS(arg) THEN
    DO
      finfo=STATEF(notename)
      IF WORDS(finfo)>7 THEN
        DO
          temp=plaindir
          x=lastslash(WORD(finfo,8))
          arg=WORD(x,1)
          CALL setdir(WORD(x,2))
          plaindir=temp
        END
    END
  x=lastslash(arg)
  IF WORDS(x)>1 THEN
    DO
      arg=WORD(x,1)
      extdir=WORD(x,2)
      CALL setdir(extdir)
    END
  uldlflag=1
  DO dloadloop=1
    IF statuscheck(arg) THEN
      DO
        errorflag=1
        LEAVE dloadloop
      END
    CALL postuser(5)
    CALL sound('DOWNLOAD')
    SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
    CALL checktime()
    UpLoad arg
    IF RC>0 | bbsXferStats(15 arg colorflag protocol extdir) THEN
      DO
        errorflag=1
        LEAVE dloadloop
      END
    CALL bytes2user(15 WORD(STATEF(arg),2))
    IF extdir='' & POS('EMAILFILES',UPPER(PRAGMA('D')))=0 THEN
      DO dloadloop2=1 TO 1
        DO di=sysoplevel+2 TO 100
          IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop2
        END
        IF readlines(notename 1) THEN
          DO
            CALL send2log('Unable to increment download count for' plaindir'/'arg)
            LEAVE dloadloop2
          END
        dls=WORD(lynes.2,7)
        IF ~DATATYPE(dls,'W') THEN dls=0
        lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1
        finfo=STATEF(notename)
        IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
        ELSE finfo=''
        CALL DELETE(notename)
        CALL savelines(notename)
        CALL DELAY(28)
        IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' notename finfo
        IF WORD(data.16,1)<WORD(lynes.1,2) THEN
          DO
            lastbrowse=WORD(lynes.1,2)
            newfilesdate=DATE('S') TIME()
          END
      END
    LEAVE dloadloop
  END
END
uldlflag=0
CALL setdir(curdir)
IF errorflag THEN SAY pen3'*** Download Failed!'def||CR
IF sleepy='LOGOFF' THEN
  DO
    SAY CR
    SAY 'Logging'pen3 'OFF' def'in 10 seconds...'CR
    SAY 'Press'pen3 RETURN def'to return to'pen3 bbsname||def||CR
    SAY CR
    Timeout 10
    WAIT '?'
    t=RC
    Timeout maxidle
    IF t~=0 THEN SIGNAL LOGOUT2
  END
RETURN errorflag


lastslash:
PARSE ARG sarg
sdir=''
slash=LASTPOS('/',sarg)
IF slash>2 THEN sdir=LEFT(sarg,slash-1)
ELSE
  DO
    slash=LASTPOS(':',sarg)
    IF slash>0 THEN sdir=LEFT(sarg,slash)
  END
IF slash>0 THEN sarg=SUBSTR(sarg,slash+1)
RETURN sarg sdir


editnote:
IF arg='' THEN
  DO
    PARSE PULL arg .
    IF arg='' THEN RETURN 0
  END
comment=''
IF ~EXISTS(arg) THEN
  DO
    finfo=STATEF(bbspath'FileNotes/'plaindir'/'arg)
    temp=''
    IF WORDS(finfo)>7 THEN comment=WORD(finfo,8)
    ELSE
      DO
        IF level<sysoplevel THEN RETURN 0
        temp=getinput(1 1 'Is this file on an another device? (Nqy)')
      END
    IF temp='Y' THEN
      DO WHILE comment=''
        comment=getinput(0 0 'Enter linkfile using full dev:path/filename > ')
        IF comment='' THEN RETURN 0
        IF ~EXISTS(comment) THEN comment=''
      END
    ELSE IF temp='Q' THEN RETURN 0
  END
IF comment='' THEN
  DO
    arg=findfiles(arg)
    IF arg=0 THEN RETURN 0
    IF DATATYPE(arg,'W') THEN arg=WORD(files.arg,2)
  END
filedir=plaindir
CALL MAKEDIR(bbspath'FileNotes/'filedir)
IF ~EXISTS(bbspath'FileNotes/'filedir) THEN
  DO
    SAY pen3'*** Failed to open directory!' filedir||def||CR
    RETURN 0
  END
notename=bbspath'FileNotes/'filedir'/'arg
lynes.=''
filenum=countcheck('Numbers/LastFile' 0)
IF level>sysoplevel THEN firstedit=1
ELSE firstedit=5
IF EXISTS(notename) THEN
  DO
    IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
    CALL bbsEd.rexx(firstedit notename name TRUNC(maxtime-TIME('E'))-28)
    CALL checkfilechanges()
    IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
    RETURN 0
  END
IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg)
ELSE filedata=STATEF(comment)
IF filedata='' THEN
  DO
    IF comment='' THEN line=filedir'/'arg
    ELSE line=comment
    SAY line 'does not exist!'CR
    RETURN 0
  END
bytes=WORD(filedata,2)
filenum=filenum+1
lynes.0=4
lynes.1='File: 'LEFT(filenum,5)' KeyWords:'
lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes   Downloads: 0'
lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')'  Lib: 'filedir
lynes.4=LEFT('',74,'=')
lynes.1=lynes.1 edkeywords(arg filedir)
diz='RAM:file_id.diz'
IF EXISTS(diz) THEN CALL readlines(diz 5)
CALL DELETE(diz)
CALL seelines(1)
edtype=''
CALL writebuffer(scratch'/NoteFile')
IF savelines(notename) THEN RETURN 0
IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
CALL DELETE(libpath||filedir'/.'STRIP(LEFT(filedir,15)))
fncom='R'
DO WHILE fncom='R'
  CALL seelines(1)
  nonstop=0
  line='['pen3'E'def']dit'
  IF level>sysoplevel THEN line=line '['pen3'K'def']ill'
  line=line '['pen3'R'def']ead ['pen3'S'def']ave'
  IF level>sysoplevel THEN line=line '(ekrS) 'def
  ELSE line=line '(erS) 'def
  fncom=getinput(1 1 line)
  IF fncom='K' & level>sysoplevel THEN
    DO
      SAY 'Killing FileNote..'CR
      CALL DELETE(notename)
      RETURN 1
    END
  ELSE IF fncom='E' THEN
    DO
      IF bbsEd.rexx(firstedit notename name TRUNC(maxtime-TIME('E'))-28)>0 THEN RETURN 0
      CALL readlines(notename 1)
      CALL checkfilechanges()
      fncom='R'
    END
  ELSE IF fncom~='R' THEN
    DO
      SAY 'Adjusting filelist...'CR
      IF filenum<1 THEN filenum=1
      IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',1)
      CALL countcheck('Numbers/LastFile' filenum)
      files.0=files.0+1
      newcount=alpha.0+1
      alpha.0=newcount
      files.filenum=plaindir arg
      files.filenum.0=newcount
      libnum=finddirnum(plaindir)
      PARSE VAR lynes.1 . 'KeyWords:' keywords
      alpha.newcount=LEFT(arg,22-LENGTH(WORD(lynes.2,4)))
      alpha.newcount=alpha.newcount WORD(lynes.2,4) RIGHT(filenum,5)
      alpha.newcount=alpha.newcount RIGHT(libnum,2) LEFT(plaindir,12)
      alpha.newcount=alpha.newcount STRIP(LEFT(STRIP(keywords),32))
      IF EXISTS(bbspath'Lists/Files') THEN
        x=listOPEN(f,bbspath'Lists/Files','A')
      ELSE x=listOPEN(f,bbspath'Lists/Files','W')
      IF x=0 THEN
        DO
          SAY '*** Failed to open' bbspath'Lists/Files'CR
          savefileflag=1
          RETURN 0
        END
      CALL WRITELN(f,filenum files.filenum)
      CALL CLOSE(f)
      IF EXISTS(bbspath'Lists/Files.ALPHA') THEN
        x=listOPEN(f,bbspath'Lists/Files.ALPHA','A')
      ELSE x=listOPEN(f,bbspath'Lists/Files.ALPHA','W')
      IF x=0 THEN
        DO
          SAY '*** Failed to open' bbspath'Lists/Files.ALPHA'CR
          RETURN 0
        END
      CALL WRITELN(f,alpha.newcount)
      CALL CLOSE(f)
      sortalphaflag=1
      CALL cleanline(1)
    END
END
RETURN 0


checkfilechanges:
x=GETCLIP('BBS_FileChange')
CALL SETCLIP('BBS_FileChange')
DO ii=1 TO WORDS(x)
  fnum=WORD(x,ii)
  keywords=GETCLIP('BBS_Keywords_'fnum)
  CALL SETCLIP('BBS_Keywords_'fnum)
  num=files.fnum.0
  alpha.num=TRIM(OVERLAY(keywords,alpha.num,47,32))
  sortalphaflag=1
END
RETURN


edkeywords:
PARSE ARG kwarg
templine=''
DO WHILE LENGTH(templine)<3
  SAY CR
  SAY pen3'Please enter a list of keywords (or a condensed description)'def||CR
  SAY pen3'to be used in the alphabetic list and by the search routine.'def||CR
  SAY '    Note that only the first 32 characters will be used.'CR
  SAY LEFT('',43)'|'LEFT('',31,'=')'|'CR
  templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
  templine=cleanstring('0:'templine)
  templine=STRIP(LEFT(templine,32))
  SAY CR
END
RETURN templine


loadfiles:
SAY def||CR
IF ~listOPEN(f,bbspath'Lists/Files','R') THEN RETURN
SAY 'Loading filelist...'CR
files.=''
files.0=0
DO i=1
  line=READLN(f)
  IF EOF(f) THEN BREAK
  num=WORD(line,1)
  IF DATATYPE(num,'W') THEN
    DO
      IF num<100 THEN
        IF LEFT(WORD(line,3),1)~='.' THEN
          DO
            CALL CLOSE(f)
            SAY CR
            SAY 'Your filelists need to be renumbered, running bbsUPDATE.rexx...'CR
            CALL bbsUPDATE.rexx()
            SIGNAL RESET
          END
      files.num=WORD(line,2) WORD(line,3)
    END
END
files.0=i-1
CALL CLOSE(f)
RETURN


savefilelist:
IF level=99 THEN
  IF getinput(1 1 'Update filelists now? (nY) > ')='N' THEN RETURN

savefilelist2:
SIGNAL OFF BREAK_E
CALL savealphalist()
filenum=countcheck('Numbers/LastFile' 0)
IF filenum<1 THEN
  DO
    IF lastfile>0 THEN filenum=lastfile+100
    ELSE RETURN
  END
xarg=bbspath'Lists/Files'
IF ~listOPEN(f,xarg,'W') THEN RETURN
SAY 'Saving filelist...'CR
savefileflag=0
DO i=1 TO filenum
  IF files.i~='' THEN CALL WRITELN(f,i files.i)
END
CALL CLOSE(f)
IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
RETURN


loadalpha:
ARG alflag
SAY def||CR
IF alflag THEN CALL checkliblists()
IF liblist='' THEN alflag=0
IF ~listOPEN(f,bbspath'Lists/Files.ALPHA','R') THEN RETURN
SAY 'Loading the alphabetical filelist...'CR
alpha.=''
alpha.0=0
DO i=1
  line=READLN(f)
  IF EOF(f) THEN LEAVE i
  fnum=WORD(line,3)
  IF DATATYPE(fnum,'W') THEN
    DO
      alpha.i=line
      files.fnum.0=i
      IF alflag THEN CALL updateliblists()
    END
  ELSE i=i-1
END
CALL CLOSE(f)
tf=bbspath'Lists/Files.ALPHA.add'
IF EXISTS(tf) & ~SHOW('P','BBSFILE') THEN
  IF readopen(tf) THEN
    DO
      DO i=i
        line=READLN(f)
        IF EOF(f) THEN LEAVE i
        fnum=WORD(line,3)
        IF DATATYPE(fnum,'W') THEN
          DO
            alpha.i=line
            files.fnum.0=i
          END
        ELSE i=i-1
        IF alflag THEN CALL updateliblists()
      END
      CALL CLOSE(f)
      CALL DELETE(tf)
      CALL SETCLIP('BBS_resave_local',1)
    END
alpha.0=i-1
IF alflag THEN CALL closeliblists()
DO i=1 TO 99
  IF dirs.i='' THEN ITERATE i
  dname='.'STRIP(LEFT(dirs.i,15))
  IF files.i='' THEN
    DO
      files.i=dirs.i dname
      files.0=files.0+1
    END
  sz=WORD(STATEF(libpath||dirs.i'/'dname),2)
  IF ~DATATYPE(sz,'W') THEN sz=0
  x=files.i.0
  IF ~DATATYPE(x,'W') THEN
    DO
      x=alpha.0+1
      files.i.0=x
      alpha.0=x
      CALL SETCLIP('BBS_resave',1)
      CALL DELETE(libpath||dirs.i'/'dname)
    END
  alpha.x=LEFT(dname,22-LENGTH(sz)) sz RIGHT(i,5) RIGHT(i,2)
  alpha.x=alpha.x LEFT(dirs.i,12) 'alphabetical files list CONTENTS'
END
IF GETCLIP('BBS_resave')=1 THEN
  DO
    CALL SETCLIP('BBS_resave')
    sortalphaflag=1
    CALL savefilelist2()
  END
IF alpha.0<files.0 THEN buildalpha=1
SAY CR
RETURN


savealphalist:
SIGNAL OFF BREAK_E
IF GETCLIP('BBS_localfiles')~='' THEN
  DO
    CALL SETCLIP('BBS_localfiles')
    CALL loadfiles()
    CALL loadalpha(0)
  END
CALL checkliblists()
IF sortalphaflag=1 THEN
  DO
    SAY 'Alphabetizing' alpha.0 'files...'CR
    IF alpha.0>0 THEN CALL QSORT(1,alpha.0,alpha)
    DO i=1 TO alpha.0
      fnum=WORD(alpha.i,3)
      files.fnum.0=i
    END
  END
sortalphaflag=0
IF files.100~='' THEN
  DO
    sz=WORD(STATEF(libpath||WORD(files.100,1)'/'WORD(files.100,2)),2)
    IF DATATYPE(sz,'W') THEN
      DO
        anum=files.100.0
        alpha.anum=OVERLAY(RIGHT(sz,7),alpha.anum,17,7)
      END
  END
IF files.101~='' THEN
  DO
    sz=WORD(STATEF(libpath||WORD(files.101,1)'/'WORD(files.101,2)),2)
    IF DATATYPE(sz,'W') THEN
      DO
        anum=files.101.0
        alpha.anum=OVERLAY(RIGHT(sz,7),alpha.anum,17,7)
      END
  END
IF ~listOPEN(f,bbspath'Lists/Files.ALPHA','W') THEN RETURN
SAY 'Saving alphabetical filelists...'CR
DO i=1 TO alpha.0
  ii=WORD(alpha.i,3)
  IF files.ii='' THEN alpha.i='0 0' ii '100'
  IF LEFT(alpha.i,4)='0 0 ' THEN ITERATE i
  CALL WRITELN(f,alpha.i)
  IF liblist~='' THEN CALL updateliblists()
END
CALL CLOSE(f)
CALL closeliblists()
CALL bbsALPHA.rexx(files.0 SUBSTR(extension,2) arccom)
DO i=0 TO 1
  t=GETCLIP('BBS_10'i)
  IF t='' THEN ITERATE i
  CALL SETCLIP('BBS_10'i)
  num=100+i
  files.num=TRANSLATE(t,,'/')
  files.0=files.0+1
  x=alpha.0+1
  files.num.0=x
  alpha.0=x
  sz=WORD(STATEF(libpath||t),2)
  IF ~DATATYPE(sz,'W') THEN sz=0
  dnum=finddirnum(WORD(files.num,1))
  alpha.x=LEFT(WORD(files.num,2),22-LENGTH(sz)) sz '  'num RIGHT(dnum,2)
  alpha.x=alpha.x LEFT(dirs.dnum,12)
  IF i THEN alpha.x=alpha.x 'alphabetical files list CONTENTS'
  ELSE alpha.x=alpha.x 'alphabetical by library CONTENTS'
  SAY 'Added file' num t 'to the filelists.'CR
  SAY 'Must now resort and resave.'CR
  CALL SETCLIP('BBS_resave',1)
END
RETURN


listOPEN:
PARSE ARG fh,listfile,flag
DO i=0 TO 59 WHILE OPEN(fh,listfile,flag)=0
  IF i//4=0 THEN SAY 'Waiting' (60-i)*5 'more seconds for' listfile 'to become available...'CR
  CALL DELAY(250)
END
IF i>59 THEN
  DO
    line='*** unable to access' listfile 'list.'
    SAY line||CR
    CALL send2log(line TIME())
    RETURN 0
  END
RETURN 1


checkliblists:
SAY 'Checking individual library filelists...'CR
liblist=''
lastlib=0
cnt.=0
DO i=1 TO 99
  IF dirs.i='' THEN ITERATE i
  finfo=STATEF(libpath||dirs.i'/.'STRIP(LEFT(dirs.i,15)))
  IF finfo='' THEN liblist=liblist i
  ELSE
    DO
      sz=WORD(finfo,2)
      num=files.i.0
      IF DATATYPE(num,'W') THEN
        alpha.num=OVERLAY(RIGHT(sz,7),alpha.num,17,7)
    END
END
liblist=STRIP(liblist)
DO j=1 TO WORDS(liblist)
  tt=WORD(liblist,j)
  CALL MAKEDIR(libpath||dirs.tt)
  lf1=libpath||dirs.tt'/.'STRIP(LEFT(dirs.tt,15))
  flg='W'
  IF EXISTS(libpath||dirs.tt'.txt') THEN
    DO
      ADDRESS COMMAND 'COPY' libpath||dirs.tt'.txt' lf1
      flg='A'
    END
  IF listOPEN(f,lf1,flg)=0 THEN ITERATE j
  IF flg='A' THEN CALL WRITELN(f,'')
  CALL WRITELN(f,'Filename          Bytes File# Library         KeyWords')
  CALL WRITELN(f,LEFT('=',77,'='))
  CALL CLOSE(f)
END
RETURN


updateliblists:
x=FIND(liblist,WORD(alpha.i,4))
IF x=0 THEN RETURN
tt=WORD(liblist,x)
IF tt~=lastlib THEN
  DO
    CALL CLOSE(a)
    lastlib=tt
    x=OPEN(a,libpath||dirs.tt'/.'STRIP(LEFT(dirs.tt,15)),'A')
    IF x=0 THEN
      DO
        lastlib=0
        RETURN
      END
  END
CALL WRITELN(a,alpha.i)
cnt.tt=cnt.tt+1
RETURN


closeliblists:
CALL CLOSE(a)
DO i=1 TO WORDS(liblist)
  tt=WORD(liblist,i)
  dname='.'STRIP(LEFT(dirs.tt,15))
  SAY ' 'dname||CR
  x=OPEN(f,libpath||dirs.tt'/'dname,'A')
  IF x~=0 THEN
    DO
      CALL WRITELN(f,LEFT('-',77,'-'))
      temp='file'
      IF cnt.tt~=1 THEN temp=temp's'
      temp=cnt.tt temp'.  Last updated' DATE() 'at' TIME('C')
      temp=temp RIGHT(bbsname,76-LENGTH(temp))
      CALL WRITELN(f,temp)
      CALL CLOSE(f)
    END
  CALL MAKEDIR(bbspath'FileNotes/'dirs.tt)
  fnote=bbspath'FileNotes/'dirs.tt'/'dname
  lynes.=''
  lynes.0=5
  x=OPEN(f,fnote,'R')
  IF x=0 THEN CALL SETCLIP('BBS_resave',1)
  ELSE
    DO
      DO k=1
        line=READLN(f)
        IF EOF(f) THEN LEAVE k
        lynes.k=line
      END
      CALL CLOSE(f)
      lynes.0=k-1
    END
  finfo=STATEF(libpath||dirs.tt'/.'STRIP(LEFT(dirs.tt,15)))
  bt=WORD(finfo,2)
  dl=WORD(lynes.2,7)
  IF ~DATATYPE(dl,'W') THEN dl=0
  lynes.1='File: 'LEFT(tt,5)' KeyWords: alphabetical files list CONTENTS'
  lynes.2='Name: 'LEFT(dname,27)' Size:' bt 'bytes  Downloads:' dl
  lynes.3='From: 'LEFT('BBBBS',27)' Date: 'DATE() TIME('C')'  Lib: 'dirs.tt
  lynes.4=LEFT('',74,'=')
  IF lynes.5='' THEN
    lynes.5='Up to the minute alphabetical filelist of the' dirs.tt 'library.'
  IF writeopen(fnote) THEN
    DO
      DO k=1 TO lynes.0
        CALL WRITELN(f,lynes.k)
      END
      CALL CLOSE(f)
      SAY LEFT(' ',LENGTH(dname)+2)'1B'x'Mupdated.'CR
    END
END
liblist=''
RETURN


edituser:
IF level>0 THEN
  IF getinput(1 1 'Change ['pen3'U'def']ser data or ['pen3'M'def']essage conference access (mU) > ')='M' THEN
    DO
      SAY CR
      SAY pen3'     - Message Conference Access -'def||CR
      SAY '[O]ff turns all message conferences OFF.'CR
      SAY '[R]eset lets you Reset to ''x'' number of messages back.'CR
      SAY 'Set the last message read by you in ALL message conferences'CR
      temp=getinput(1 1 ' ['pen3'F'def']irst  ['pen3'L'def']ast  ['pen3'O'def']ff  ['pen3'R'def']eset  ['pen3'Q'def']uit  (florQ) > ')
      IF POS(temp,'FLOR')=0 THEN RETURN
      back=0
      IF temp='R' THEN
        back=getnumber('Set each conference pointer back how many messages?')
      SAY 'Resetting...'lineup||CR
      data.22=''
      DO i=1 TO level
        IF temp='F' THEN num=0
        ELSE IF temp='O' THEN num=-1
        ELSE
          DO
            num=countcheck('Numbers/LastMessage'i 0)-back
            IF num<1 THEN num=0
          END
        data.22=data.22 num
      END
      CALL setdata()
      CALL sortconferences()
      CALL savedata(1)
      RETURN
    END
new=0
change=0
edata.=''
edname=name
DO i=0 TO data.0
  edata.i=data.i
END
num=1
DO WHILE num~='' | edname~=name
  IF num='' | LEFT(num,1)='Q' THEN
    DO
      IF change THEN
        DO
          CALL setdata()
          CALL savedata(1)
          change=0
        END
      IF new THEN
        DO
          data.=''
          DO i=0 TO edata.0
            data.i=edata.i
          END
          name=edname
          new=0
        END
      CALL setdata()
    END
  maxnum=10
  IF edata.20>sysoplevel THEN maxnum=20
  IF edata.20=99 THEN maxnum=27
  SAY bak2' 'name' 'def||CR
  maxlines=21
  IF maxnum=10 THEN maxlines=20
  DO i=1 TO maxlines
    IF i=5 & name~=edname & edata.20<99 THEN ITERATE
    SAY RIGHT(i,2)||pen3 text.i||def':' data.i||CR
  END
  IF edata.20>sysoplevel THEN
    DO
      line=LEFT(' ',50)
      IF name=edname THEN line=line'NEW = Change User.'
      line=pen3||line||def||lineup
      SAY line||CR
    END
  num=getinput(1 0 'Select Line Number To Edit: ')
  IF num='NEW' & edata.20>sysoplevel & edname=name THEN    /* select a new user */
    DO
      new=1
      IF change THEN
        DO
          CALL setdata()
          CALL savedata(1)
        END
      change=0
      nufile=bbspath'Lists/NEW_USERS'
      IF EXISTS(nufile) THEN CALL showtext(nufile 0)
      savename=name
      name=getinput(1 0 'New User Name: 'def)
      name=cleanstring(1':'name)
      IF loaddata()=0 THEN name=savename
      IF data.20>=edata.20 THEN
        DO
          SAY 'Can''t Edit!' pen3||name def'has an equal or higher level than thee.'
          name=savename
          CALL loaddata()
        END
    END
  ELSE IF DATATYPE(num,'W') & num>0 THEN
    DO
      IF num>maxnum THEN
        DO
          SAY CR
          SAY pen3'You are not authorized to change that information!'def||CR
          SAY CR
        END
      ELSE
        DO dummy=1 TO 1
          IF num=8 THEN
            DO
              SAY CR
              SAY 'Use spaces to separate options.'CR
              SAY 'If the option word is in line 8, it is ON.'CR
              SAY 'Valid Options:'CR
              SAY '        CLEAR  clears screen between pages.'CR
              SAY '        COLOR  turns ANSI color codes ON.'CR
              SAY '        MENU   combines all main commands into 1 menu.'CR
              SAY '        MENUS  splits main commands into 3 menus.'CR
              SAY '        PHONE  makes your phone number public.'CR
              SAY '        QUICK  activates offline options. See bbsQUICK.DOC'CR
              SAY '        STREET makes your street address public.'CR
              SAY '        TERSE  skips some of the logon procedures.'CR
              SAY CR
            END
          line=RIGHT(num,2)||pen3 text.num||def': '
          SAY line||data.num||CR
          temp=getinput(0 0 line)
          IF temp='' THEN
            DO
              IF num=1 | num=4 | num=5 | num=6 | num=7 THEN LEAVE dummy
              IF num=11 | num=12 | num=13 | num=20 THEN LEAVE dummy
            END
          IF num=5 | num=8 THEN temp=UPPER(temp)
          IF num=20 & DATATYPE(temp,'W') & temp>=edata.20 THEN
            temp=data.20
          IF edata.20>sysoplevel & name~=edname THEN line2=name' '
          ELSE line2=''
          IF num=21 & name=edname & edata.20<99 THEN LEAVE dummy
          line=text.num':' data.num pen6'CHANGED TO'def temp
          CALL send2log(line2||line)
          data.num=temp
          SAY line||CR
          SAY CR
          change=1
        END
    END
END
IF change THEN
  DO
    CALL setdata()
    CALL savedata(1)
  END
RETURN


setmsgs:
IF ~DATATYPE(bbsprefs.25,'W') THEN RETURN
data.22=''
data.23=''
SAY CR
line='Setting message counters to last'
IF bbsprefs.25>1 THEN line=line bbsprefs.25 'messages'
ELSE line=line 'message'
line=line 'in each conference...'
SAY line||CR
DO i=1 TO level
  num=countcheck('Numbers/LastMessage'i 0)-bbsprefs.25
  IF num<0 | msg.i.0<bbsprefs.25 THEN num=0
  lastread.i=num
  data.22=data.22 num
  data.23=data.23 0
END
SAY 'Setting file counter to last file uploaded...'CR
lastbrowse=countcheck('Numbers/LastFile' 0)
newfilesdate=DATE('S') TIME()
RETURN


getnumber:
PARSE ARG tprompt
tnum=getinput(1 0 '  'tprompt' > ')
mask=COMPRESS(XRANGE(),'0123456789')
tnum=COMPRESS(tnum,mask)
IF ~DATATYPE(tnum,'W') THEN tnum=0
tnum=tnum%1
IF tnum>0 & tnum<10 THEN tnum='0'tnum
RETURN tnum


getbirth:
data.12=WORD(data.12,1)'  'WORD(data.12,2)'  Birthday:'
SAY pen3'Birthday Information:'def||CR
month=getnumber('Please enter the MONTH you were born: (1-12)')
day=getnumber('Please enter the DAY   you were born: (1-31)')
year=getnumber('Please enter the YEAR  you were born:       ')
IF year<100 THEN year=year+1900
born=year||month||day
IF born<18750101 | born>(DATE('S')-50000) THEN   /* must be older than 4 */
  DO
    born=''
    IF getinput(1 1 'Would you rather skip this question? (Ny) > ')~='Y' THEN
      CALL getbirth()
  END
data.12=WORD(data.12,1)'  'WORD(data.12,2)'  'WORD(data.12,3)' 'WORD(born,1)
RETURN


getname:
nonstop=0
CALL showuserlist()
SAY CR
waitchar='Q'
CALL showtext(bbspath'BBS_TEXT/NEW_USER_NAME' 1)
pline='Your name on'pen3 bbsname def'will be > '
name=getinput(1 0 pline)
name=cleanstring(1':'name)
IF name='' THEN
  DO
    name=getinput(1 0 pline)
    name=cleanstring(1':'name)
    IF name='' THEN
      DO
        SAY 'No name, no entry.  Bye!'CR
        SIGNAL DONE
      END
  END
IF EXISTS(bbspath'Users/'name) | FIND(exclusion,name)>0 THEN
  DO
    SAY 'Sorry! That name is taken. Please try again.'CR
    RETURN 1
  END
IF LENGTH(name)=1 THEN
  DO
    SAY 'One letter names are not allowed,' name', please try again.'CR
    RETURN 1
  END
IF getinput(1 1 'Your name on'pen3 bbsname def'will be >' name', is that correct? (nY) > ')='N' THEN
  RETURN 1
RETURN 0


/** see if name is in data */

checkUser:
tries=0
IF name='NEW' THEN
  DO
    name=''
    DO WHILE getname()
    END
    CALL postuser(7)
  END
IF ~EXISTS(bbspath'Users/'name) THEN
  DO
    IF EXISTS(bbspath'BBS_TEXT/NEW') THEN
      DO
        nonstop=0
        CALL showtext(bbspath'BBS_TEXT/NEW' 1)
      END
    SAY CR
    IF getinput(1 1 'Do you want to register? (nY) > ')='N' THEN
      DO
        SAY 'Thanks anyway, bye!'CR
        line=name 'did not want to register.'
        SIGNAL OUT2
      END
    defile=bbspath'BBS_TEXT/DEF.NEW_USER'
    CALL loadcourtesy()
    wordnum=FIND(courtesy,name)
    IF wordnum>0 THEN
      DO
        SAY name', is on the Courtesy List. You will be granted immediate access.'CR
        courtesy=STRIP(DELWORD(courtesy,wordnum,1))
        IF writeopen(bbspath'Lists/Courtesy') THEN
          DO
            DO i=1 TO WORDS(courtesy)
              CALL WRITELN(f,WORD(courtesy,i))
            END
            CALL CLOSE(f)
          END
        defile=bbspath'BBS_TEXT/DEF.COURTESY'
      END
    ELSE IF bbsprefs.7=0 THEN SAY name', You have new user access.'CR
    IF readlines(defile 1) THEN SIGNAL DONE
    CALL sound('NEW_USER')
    data.=''
    data.0=27
    DO i=6 TO 22
      data.i=lynes.i
    END
    data.12=DATE('S')'  'TIME('C')
    data.13=data.12
    lastondate=DATE('I')-1
    lastontime=TIME('C')
    x=FIND(UPPER(data.8),'COLOR')
    test=getinput(1 1 'Do you see colors ('pen3'ANSI' pen2'C'pen3'O'pen5'L'pen6'O'pen7'R' pen3'codes'def') on this line? (nY) > ')
    IF test='N' THEN
      DO
        IF x>0 THEN data.8=DELWORD(data.8,x,1)
        CALL colors(0)
      END
    ELSE IF x=0 THEN
      DO
        data.8=data.8 'COLOR'
        CALL colors(1)
      END
    DO i=60 TO 2 BY -1
      SAY RIGHT('- 'i' -',14)||CR
    END
    data.7=getinput(1 0 'What number is now at the top of your screen? > ')
    IF data.7<17 | data.7>75 THEN data.7=20
    SAY 'Please enter the password you would like to use here.'CR
    data.5=getinput(1 0 'Enter Password: ')
    DO WHILE getinput(1 1 'Your password on' bbsname 'will be :' data.5 ', is that correct? (nY) > ')='N'
      data.5=getinput(1 0 'Enter Password: ')
    END
    IF data.5='' THEN
      DO
        line=name 'refused to enter a password.'
        SIGNAL DONE
      END
    data.1=''
    DO WHILE data.1=''
      data.1=getinput(0 0 'Full (real) Name: ')
      IF data.1='' THEN SAY 'You MUST leave your real name!'CR
    END
    data.2=getinput(0 0 'Street: ')
    data.3=getinput(0 0 'City, State Zip: ')
    data.4=''
    DO WHILE data.4=''
      data.4=getinput(0 0 'Voice Phone (including areacode): ')
      IF data.4='' THEN
        SAY sysop 'MUST be able to reach you by phone to validate you!'CR
    END
    CALL getbirth()
    IF bbsprefs.8 THEN
      DO
        newufile=bbspath'Lists/NEW_USERS'
        IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
        ELSE
          DO
            ok=OPEN(f,newufile,'W')
            IF ok~=0 THEN CALL WRITELN(f,'*** New Users ***')
          END
        IF ok~=0 THEN
          DO
            temp=RIGHT(TIME('C'),7) COMPRESS(DATE())
            temp=temp LEFT(name,24)'=' data.1'  'data.4
            CALL WRITELN(f,temp)
          END
        CALL CLOSE(f)
      END
    data.9=getinput(0 0 'Computer: ')
    data.10=getinput(0 0 'Interests: ')
    test=getinput(1 1 pen3'Do you want other users to see your STREET address? (Ny) > 'def)
    IF test='Y' THEN data.8=data.8 'STREET'
    test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (Ny) > 'def)
    IF test='Y' THEN data.8=data.8 'PHONE'
    IF bbsprefs.7>0 THEN
      DO
        data.20=bbsprefs.7
        CALL do_eleven(60 bbsprefs.16 bbsprefs.16-1)
      END
    SAY CR
    CALL setdata()
    IF data.20=0 THEN
      SAY 'Thank you, the sysop will give you higher access soon.'CR
    ELSE CALL setmsgs()
    SAY CR
    SAY 'Please feel free to leave additional info by using [C]omment.'CR
    SAY CR
    CALL savedata(1)
    SAY 'Adding' name 'to the user list...'CR
    newpassword=data.5
    sortuserflag=1
    temp=countcheck('Numbers/Users' 0)+1
    CALL countcheck('Numbers/Users' temp)
  END
ELSE
  DO
    IF loaddata()=0 THEN SIGNAL DONE
    city=docity(data.3)
    PARSE VAR data.11 amins . . . ttimes . . . atimes .
    lastondate=DATE('I',WORD(data.13,1),'S')
    lastontime=WORD(data.13,2)
    IF DATE('I')>lastondate | level>=sysoplevel THEN atimes=ttimes
    IF level=99 THEN amins=120
    data.13=DATE('S')'  'TIME()
    CALL do_eleven(amins ttimes atimes-1)
    IF atimes<1 & DATE('I')=lastondate THEN
      DO
        SAY CR
        SAY CR
        line= 'Too many calls today.   Call tomorrow.'
        SAY line||CR
        SAY CR
        SAY CR
        CALL send2log(line)
        IF atimes<(-1) THEN SIGNAL LOGOUT2
        ELSE SIGNAL LOGOUT
      END
    data.13=DATE('S')'  'TIME('C')
    SAY CR
    SAY pen3'Password will'def 'NOT' pen3'be echoed.'def||CR
    SAY CR
    passprompt='Enter Password: '
    DO tries=1 TO 3
      Send passprompt
      Remote OFF
      OPTIONS PROMPT ''
      newpassword=getinput(1 0 '')
      Remote ON
      IF(password=newpassword) THEN
        DO
          SAY ''CR
          LEAVE tries; /* correct password */
        END
      IF tries=3 THEN
        DO             /* 3 tries, hang up */
          SAY ''CR
          SAY 'Access terminated.'CR
          line='*** Bad password ***' newpassword '***'
          SAY line||CR
          city=line
          CALL postuser(6)
          SIGNAL OUT2
        END
      SAY ''lineup'                                 'CR
      passprompt='Incorrect.  Password: ' /* ask again */
    END
  END
SAY CR
IF bbsprefs.23=1 THEN
  ADDRESS AREXX bbsSpeak.rexx 'LOGON' name bbspath saypath
RETURN


do_eleven:
ARG am tc at .
data.11=am 'minutes per call,' tc 'calls per day,'
data.11=data.11 at 'more calls today'
RETURN


savedata:
ARG messflag .
IF data.5='' THEN RETURN
temp=GETCLIP(name'_UPDATE')
IF temp~='' THEN
  DO
    CALL SETCLIP(name'_UPDATE')
    PARSE VAR temp upfiles' 'upbytes' 'upmail' 'upmsg
    IF upfiles>0 THEN
      DO
        files=WORD(data.14,1)
        bytes=WORD(data.14,3)
        IF DATATYPE(files,'W') THEN upfiles=upfiles+files
        IF DATATYPE(bytes,'W') THEN bytes=upbytes
        data.14=upfiles 'files' bytes 'bytes.' DATE()
      END
    IF upmail>0 THEN
      DO
        mail=WORD(data.17,2)
        IF DATATYPE(mail,'W') THEN upmail=upmail+mail
        data.17=WORD(data.17,1) upmail WORD(data.17,3)
      END
    IF upmsg~='' THEN
      DO
        temp=data.23
        DO i=1 TO level
          smsg=WORD(temp,i)
          IF ~DATATYPE(smsg,'W') THEN smsg=0
          IF FIND(upmsg,i) THEN smsg=smsg+1
          data.23=data.23 smsg
        END
      END
  END
SAY 'Updating...             'lineup||CR
SIGNAL OFF BREAK_E
Status Trans
data.6=STRIP(RESULT)
IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate
ELSE IF lastbrowse>0 THEN
  DO
    IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1)
    ELSE data.16=DATE('S') TIME()
    data.16=lastbrowse data.16
  END
IF DATATYPE(winnings,'N') THEN data.18=winnings
ELSE data.18=0
IF messflag THEN
  DO
    userexclude.=0
    DO si=1 TO WORDS(data.22)
      IF WORD(data.22,si)=-1 THEN userexclude.si=1
    END
    data.22=''
    data.23=''
    DO si=1 TO level
      IF ~DATATYPE(lastread.si,'W') THEN lastread.si=0
      IF userexclude.si THEN data.22=data.22 '-1'
      ELSE data.22=data.22 lastread.si
      IF ~DATATYPE(totwrit.si,'W') THEN totwrit.si=0
      data.23=data.23 totwrit.si
    END
  END
IF writeopen(bbspath'USERS/'name)=0 THEN RETURN
IF data.0<27 THEN data.0=27
DO i=1 TO data.0
  CALL WRITELN(f,data.i)
END
CALL CLOSE(f)
SAY 'User' name 'has been updated.'CR
RETURN


loaddata:
IF name='' THEN RETURN 0
IF ~readopen(bbspath'USERS/'name) THEN RETURN 0
data.=''
DO i=1
  line=READLN(f)
  IF EOF(f) THEN BREAK
  data.i=line
END
data.0=i-1
CALL CLOSE(f)
winnings=WORD(data.18,1)
IF ~DATATYPE(winnings,'N') THEN winnings=0

setdata:
IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
lastbrowse=WORD(data.16,1)
IF ~DATATYPE(lastbrowse,'W') THEN lastbrowse=0
level=data.20
DO i=1 TO level
  lastread.i=WORD(data.22,i)
  IF ~DATATYPE(lastread.i,'W') THEN lastread.i=0
  totwrit.i=WORD(data.23,i)
  IF ~DATATYPE(totwrit.i,'W') THEN totwrit.i=0
END
password=data.5
IF data.6='' THEN
  DO
    Status Trans
    data.6=RESULT
  END
ELSE
  DO
    IF RIGHT(UPPER(data.6),2)='-G' THEN data.6='G'
    IF RIGHT(UPPER(data.6),3)='-1K' THEN data.6='K'
    IF LEFT(UPPER(data.6),1)='A' THEN data.6='Z'
    Set UPPER(LEFT(data.6,1))
  END
IF ~DATATYPE(data.7,'W') THEN data.7=20
IF data.7<5 THEN data.7=5
linesperpage=data.7
IF FIND(UPPER(data.8),'TERSE')>0 THEN terseflag=1
ELSE terseflag=0
IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
ELSE colorflag=0
CALL colors(colorflag)
IF FIND(UPPER(data.8),'CLEAR')>0 THEN clr='0C'x
ELSE clr=''
menu='ALL'
IF FIND(UPPER(data.8),'MENUS')>0 THEN
  DO
    menuflag=1
    menu='MAIN'
  END
ELSE IF FIND(UPPER(data.8),'MENU')>0 THEN menuflag=1
ELSE menuflag=0
IF level=0 THEN menu='NEW'
IF DATATYPE(WORD(data.11,3),'W') THEN
  DO
    PARSE VAR data.11 amins . atimes .
    CALL do_eleven(amins bbsprefs.16 atimes)
  END
data.21=UPPER(data.21)
maxtime=WORD(data.11,1)*60
CALL MAKEDIR(bbspath'Friends')
alias.=''
alias.0=0
realname.=''
CALL CLOSE(f)
IF OPEN(f,bbspath'Friends/'name,'R')=0 THEN RETURN 1
DO i=1
  line=READLN(f)
  IF EOF(f) THEN LEAVE i
  alias.i=WORD(line,1)
  realname.i=WORD(line,2)
END
alias.0=i-1
CALL CLOSE(f)
RETURN 1


switchmenuflag:
IF menuflag=1 THEN
  DO
    menuflag=0
    noff='OFF'
  END
ELSE
  DO
    menuflag=1
    noff='ON'
  END
SAY 'Menus turned' pen3||noff||def'.'CR
SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.'CR
RETURN


switchcolors:
IF colorflag=1 THEN
  DO
    colorflag=0
    noff='OFF'
  END
ELSE
  DO
    colorflag=1
    noff='ON'
  END
CALL colors(colorflag)
SAY 'Color turned' pen3||noff||def'.'CR
SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.'CR
RETURN


/* ANSI pen color codes */
colors:
ARG onoff
IF onoff THEN
  DO
    def='';  /* default */
    pen0='';  pen1='';  pen2='';  pen3=''
    pen4='';  pen5='';  pen6='';  pen7=''
    bak0='';  bak1='';  bak2='';  bak3=''
    bak4='';  bak5='';  bak6='';  bak7=''
  END
ELSE
  DO
    pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
    bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
    def=''
  END
RETURN


chpro:
arg=UPPER(LEFT(arg,1))
IF(arg='') THEN
  DO
    SAY CR
    SAY '['pen3'W'def']- WXModem'CR
    SAY '['pen3'X'def']- XModem-CRC'CR
    SAY '['pen3'K'def']- XModem-1K'CR
    SAY '['pen3'Y'def']- YModem'CR
    SAY '['pen3'G'def']- YModem-G'CR
    SAY '['pen3'Z'def']- ZModem'CR
    SAY CR
    arg=getinput(1 0 STRIP(protocol) '> ')
 END
IF LEFT(UPPER(arg),1)='A' THEN arg='Z'
Set arg
Status Transfer
protocol=STRIP(RESULT)
SAY protocol||CR
RETURN


sortinfofiles:
infolist=SHOWDIR(bbspath'Information')
IF infolist='' THEN
  DO
    SAY CR
    SAY pen3'No files are currently in the Information drawer.'def||CR
    SAY CR
    RETURN 1
  END
IF ~DATATYPE(sortinfo.0,'W') THEN
  DO
    info.=''
    sortinfo.=''
    info.0=WORDS(infolist)
    DO i=1 TO info.0
      info.i=WORD(infolist,i)
    END
    SAY 'Sorting..'CR
    IF info.0>0 THEN CALL QSORT(1,info.0,info)
    sortinfo.0=info.0%3
    IF (info.0//3)>0 THEN sortinfo.0=sortinfo.0+1
    DO i=1 TO sortinfo.0
      sortinfo.i=''
      DO j=0 TO 2
        k=i+j*sortinfo.0
        IF k<=info.0 THEN
          DO
            sortinfo.i=sortinfo.i RIGHT(k,3)'.' LEFT(info.k,19)
            infocount=WORD(STATEF(bbspath'Information/'info.k),8)
            sortinfo.i.0=sortinfo.i.0||RIGHT(infocount,5) LEFT(info.k,19)
          END
      END
    END
    SAY lineup'         'lineup||CR
  END
RETURN 0


information:
IF sortinfofiles() THEN RETURN
CALL sound('INFO')
num=1
readcount=-1
DO infoloop=1
  CALL postfour('   Information: Menu')
  IF num=0 THEN
    DO
      IF readcount~=-1 THEN
        DO
          sortinfo.0=''
          IF sortinfofiles() THEN RETURN
        END
      SAY CENTER('- Number of accesses per file -',75)||CR
    END
  ELSE SAY pen3'These text files are available for reading online...'def||CR
  SAY pen3||LEFT('-',75,'-')||def||CR
  DO i=1 TO sortinfo.0
    IF num=0 THEN SAY sortinfo.i.0||CR
    ELSE SAY sortinfo.i||CR
  END
  SAY pen3||LEFT('-',75,'-')||def||CR
  CALL checktime()
  IF num=0 THEN
    DO
      CALL waiting()
      num=1
      ITERATE infoloop
    END
  num=getinput(1 0 pen3'Select Number Of Information File To View. 0=Stats > 'def)
  IF num=0 THEN ITERATE infoloop
  IF ~DATATYPE(num,'W') | num<1 | num>info.0 THEN RETURN
  readcount=STATEF(bbspath'Information/'info.num)
  readbytes=WORD(readcount,2)
  SAY '  'info.num 'is' readbytes 'bytes.'CR
  CALL postfour('Information:' info.num)
  IF getinput(1 1 '['pen3'R'def']ead or ['pen3'D'def']ownload? (dR) > ')='D' THEN
    DO
      allargs=bbspath'Information/'info.num
      CALL dload2()
    END
  ELSE
    DO
      SAY 'Loading File...'CR
      CALL Increment.rexx(bbspath'Information/'info.num)
      CALL DELAY(28)
      CALL readlines(bbspath'Information/'info.num 1)
      CALL cleanline(0)
      SAY lineup'    'lynes.0 'lines.'CR
      SAY CR
      CALL seelines(0)
    END
  CALL showtime()
  IF waitchar~='Q' THEN CALL waiting()
  nonstop=0
END
RETURN


newfiles:
SAY CR
test=getinput(1 1 'Show one library only? (Ny) > ')
IF test='Y' THEN
  IF chdir()>0 THEN RETURN
SAY 'Searching for new (un-browsed) files since' DATE(,WORD(data.16,2),'S') 'at' WORD(data.16,3)'...'CR
lastbrowz=WORD(data.16,1)
lastfile=countcheck('Numbers/LastFile' 0)

newfiles2:
IF lastbrowz>=lastfile THEN
  DO
    lastbrowz=0
    SAY pen3'No new files. Listing backwards by date from last file uploaded...'def||CR
  END
ELSE newfilesflag=1
j=0
IF test='Y' THEN
  DO
    filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))-1
    CALL busywait(4 1)
  END
DO ni=lastfile TO lastbrowz+1 BY -1
  IF files.ni~='' THEN
    DO
      IF test='Y' THEN
        DO
          IF ni>1 THEN CALL busywait(60 ni lastfile-lastbrowz)
          IF j>=filecount THEN LEAVE ni
          IF UPPER(LEFT(WORD(files.ni,1),12))~=UPPER(LEFT(plaindir,12)) THEN
            ITERATE ni
        END
      jj=files.ni.0
      IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(WORD(files.ni,1)))>0 THEN
        ITERATE ni  /* unauthorized */
      IF test='Y' THEN CALL busywait(4 0)
      j=j+1
      IF j=1 THEN CALL fileheader()
      SAY alpha.jj||CR
      IF (j+2)//(linesperpage-1)=0 THEN
        IF waiting2() THEN LEAVE ni
      IF test='Y' THEN CALL busywait(4 1)
    END
END
IF test='Y' THEN CALL busywait(4 0)
IF j//linesperpage~=0 THEN CALL waiting()
IF j=0 & newfilesflag=1 THEN
  DO
    lastbrowz=999999
    newfilesflag=0
    CALL newfiles2()
  END
IF test~='Y' THEN
  DO
    CALL newinfo()
    IF lynes.0>0 THEN CALL waiting()
  END
nonstop=0
RETURN


newinfo:
lynes.=''
lynes.0=0
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
startline=1
arg=bbspath'Information'
IF WORD(STATEF(arg),5)>lastondate THEN
  DO
    ADDRESS COMMAND 'C:LIST >'scratch'/dirlist' arg 'NOHEAD DATES SINCE' sincedate
    IF WORD(STATEF(scratch'/dirlist'),2)>3 THEN
      DO
        lynes.startline=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def
        CALL readlines(scratch'/dirlist' startline+1)
      END
  END
arg=bbspath'Profiles'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  DO
    ADDRESS COMMAND 'C:LIST >'scratch'/dirlist' arg 'NOHEAD DATES SINCE' sincedate
    IF WORD(STATEF(scratch'/dirlist'),2)>3 THEN
      DO
        startline=lynes.0+2
        lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def
        CALL readlines(scratch'/dirlist' startline+1)
      END
  END
arg=bbspath'rexxDoors/Data/Polls'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  DO
    startline=lynes.0+2
    lynes.startline=pen1||bak2' Voting Activity. Enter'def pen3'J'def bak2'from the main menu, then select Polling_Place 'def
    lynes.0=startline
  END
IF logonflag=1 THEN nonstop=1
IF lynes.0>0 THEN CALL seelines(1)
nonstop=0
RETURN


chdir:
string=''
SAY pen3||LEFT('-',75,'-')||def||CR
DO i=1 TO libs.0
  SAY libs.i||CR
END
SAY pen3||LEFT('-',75,'-')||def||CR
dirnum=getinput(1 0 pen3'Select Library Number: 'def)
IF clr~='' THEN Send clr
IF ~DATATYPE(dirnum,'W') THEN
  DO
    waitchar=dirnum
    RETURN 2
  END

chdir2:
IF dirnum<1 | dirnum>99 THEN
  DO
    waitchar=dirnum
    RETURN 1
  END
IF dirs.dirnum='' THEN
  DO
    SAY pen3'That library number is currently un-assigned.'def||CR
    RETURN 1
  END
IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN
  DO
    SAY pen3'You do not have authorization for that library!'def||CR
    RETURN 1
  END
td=libpath||dirs.dirnum
CALL MAKEDIR(td)
CALL setdir(td)
IF libtext=0 THEN
  IF EXISTS(td'/.'STRIP(LEFT(dirs.dirnum,15))) THEN RETURN 0
t=libpath||plaindir'.txt'
IF terseflag | ~EXISTS(t) THEN RETURN 0
nonstop=1
SAY CR
CALL readlines(t 1)
CALL seelines(1)
SAY CR
nonstop=0
RETURN 0


since:
dm=DATE(,WORD(data.16,2),'S')
SAY CR
SAY 'New files or files moved since' dm||CR
CALL listsince()
CALL readlines(scratch'/dirlist' 1)
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN


listsince:
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
ADDRESS COMMAND 'C:list >'scratch'/dirlist' directory 'DATES SINCE' sincedate
RETURN


list:
onetime=0
IF DATATYPE(arg,'W') THEN onetime=1
ELSE arg=''
DO listloop=1
  IF DATATYPE(arg,'W') THEN
    DO
      dirnum=arg
      arg=''
      IF chdir2()>0 THEN RETURN
      CALL listsimple()
      IF waitchar='Q' | onetime THEN LEAVE listloop
    END
  ELSE IF arg='' THEN
    DO
      libtext=0
      IF chdir()>0 THEN
        DO
          libtext=1
          RETURN
        END
      test='Y'
      CALL showalpha2()
      arg=''
      IF waitchar='Q' THEN waitchar=''
      IF waitchar~='' THEN RETURN
      ITERATE listloop
    END
  ELSE RETURN
END
RETURN


listsimple:
ADDRESS COMMAND 'C:list >'scratch'/dirlist' directory 'DATES'
IF readlines(scratch'/dirlist' 1) THEN RETURN
IF lynes.0>3 THEN
  DO
    SAY pen3'Sorting...'def||lineup||CR
    linesave=lynes.1  /* these 4 lines put in to leave dir title at top */
    lynes.1='0'
    IF lynes.0>1 THEN CALL QSORT(1,lynes.0-1,lynes)
    CALL DELAY(14)
    lynes.1=linesave
  END
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN


browse:
curdironly=0
brdir=PRAGMA('D')
brfilenum=1
nonstop=0
IF files.0<1 THEN RETURN
lastfile=countcheck('Numbers/LastFile' 0)
IF lastfile<1 THEN RETURN
CALL postfour('Browse:' arg)
onearg=0
IF arg='' THEN
  DO
    lin='Browsing'
    test=getinput(1 1 'Browse one library only? (Ny) > ')
    IF test='Y' THEN
      DO
        IF chdir()>0 THEN RETURN
        curdironly=1
        lin=lin 'the' pen3||plaindir||def 'library'
        t=libpath||plaindir'.txt'
        IF edinfo(t,plaindir,'File Library') THEN RETURN
      END
    ELSE lin=lin 'all file libraries'
    lin=lin 'backwards from latest file.'
    SAY lin||CR
    SAY CR
  END
ELSE onearg=1
i=0
IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN
  DO lastfileloop=1
    IF lastfile<1 THEN RETURN
    arg=WORD(files.lastfile,2)
    brfilenum=lastfile
    IF WORD(files.lastfile,2)~='' THEN LEAVE lastfileloop
    lastfile=lastfile-1
  END
ELSE IF DATATYPE(arg,'W') THEN
  DO
    brfilenum=arg
    arg=WORD(files.arg,2)
    IF arg='' THEN
      DO
        SAY 'File number' brfilenum 'does not exist in the current libraries!'CR
        RETURN
      END
  END
ELSE
  DO
    IF onearg THEN CALL busywait(4 1)
    DO ni=lastfile TO 1 BY -1
      IF onearg THEN CALL busywait(60 ni lastfile)
      IF UPPER(WORD(files.ni,2))~=UPPER(arg) THEN ITERATE ni
      brfilenum=ni
      CALL busywait(4 0)
      LEAVE ni
    END
    IF ni<1 THEN
      DO
        SAY 'Unable to find a file description for' pen3||arg||def'.'CR
        RETURN
      END
  END
IF ~curdironly THEN CALL setdir(libpath||WORD(files.brfilenum,1))
savearg=arg
IF brfilenum>lastfile THEN brfilenum=lastfile
newfilesdate=DATE('S') TIME()
DO browseloop=1
  IF curdironly THEN CALL busywait(4 1)
  DO ni=brfilenum TO 0 BY -1
    IF ni=0 THEN LEAVE browseloop
    IF files.ni='' THEN ITERATE ni
    IF onearg THEN
      DO
        CALL busywait(60 ni lastfile)
        IF UPPER(arg)~=UPPER(WORD(files.ni,2)) THEN ITERATE ni
        IF (ni//30)>0 THEN CALL busywait(4 1)
        LEAVE ni
      END
    testdir=UPPER(WORD(files.ni,1))
    IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN
      DO
        IF ni>lastbrowse THEN lastbrowse=ni
        IF ni>0 THEN CALL busywait(60 ni lastfile)
        ITERATE ni
      END
    IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN
      DO
        IF ni>lastbrowse THEN lastbrowse=ni
        ITERATE ni
      END
    LEAVE ni
  END
  IF curdironly | onearg THEN CALL busywait(4 0)
  onearg=0
  IF ni=0 THEN brfilenum=lastbrowse
  ELSE brfilenum=ni
  argname=WORD(files.brfilenum,2)
  IF argname='' THEN RETURN
  CALL setdir(libpath||WORD(files.brfilenum,1))
  arg=bbspath'FileNotes/'plaindir'/'argname
  CALL readlines(arg 1)
  IF nonstop=1 THEN brostop=1
  ELSE brostop=0
  CALL seelines(1)
  IF brfilenum>lastbrowse THEN lastbrowse=brfilenum
  CALL checktime()
  IF brostop THEN
    DO
      SAY CR
      nonstop=1
      brfilenum=brfilenum-1
    END
  ELSE
    DO
      CALL postfour('Browse:' brfilenum plaindir'/'argname)
      line=''
      endtest=UPPER(RIGHT(argname,4))
      IF FIND('.ARC .ARJ .DMS .LZH .LHA .RUN .ZIP .ZOO',endtest)>0 THEN
        line='['pen3'C'def']ontents ['pen3'D'def']ownload'
      ELSE line='['pen3'D'def']ownload'
      IF level>sysoplevel | name=WORD(lynes.3,2) THEN
        line=line '['pen3'E'def']dit'
      IF level>sysoplevel | name=WORD(lynes.3,2) THEN
        line=line '['pen3'K'def']ill'
      IF level>sysoplevel THEN line=line '['pen3'L'def']ib'
      line=line '['pen3'M'def']ark ['pen3'N'def']on-Stop'
      IF endtest='.TXT' | UPPER(argname)='.'UPPER(STRIP(LEFT(plaindir,15))) THEN
        line=line '['pen3'R'def']ead'
      line=line '['pen3'Q'def']uit ['pen3'?'def'] > '
      brcom=getinput(1 0 line)
      IF DATATYPE(brcom,'W') THEN
        DO
          brfilenum=brcom+1
          IF brfilenum>lastfile THEN brfilenum=lastfile+1
          IF brfilenum<1 THEN brfilenum=1
          SAY CR
        END
      ELSE brcom=LEFT(brcom,1)
      CALL cleanline(0)
      IF brcom='Q' THEN LEAVE browseloop
      IF brcom='M' THEN
        DO
          wordnum=FIND(data.25,brfilenum)
          IF wordnum=0 THEN
            DO
              data.25=STRIP(data.25 brfilenum)
              SAY lineup||argname 'marked for next download.'CR
              SAY CR
            END
          ELSE
            DO
              data.25=STRIP(DELWORD(data.25,wordnum,1))
              SAY argname 'removed from download list.'CR
            END
        END
      IF brcom='H' | brcom='?' THEN
        DO
          SAY pen3' - HELP with the Browse Files commands -'def||CR
          SAY ' RETURN reads the next file description in line.'CR
          SAY ' 34 will display the description of file number 34, if it exists.'CR
          SAY ' C  displays the contents of an archived (arc dms lzh lha zip zoo) file.'CR
          SAY ' D  displays the download menu.'CR
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
          SAY ' E  puts this file description into the online Editor.'CR
          SAY ' K  deletes a file you uploaded. you cannot Kill others!'CR
            END
          IF level>sysoplevel THEN
          SAY ' L  move file and description to new Library and/or rename.'CR
          SAY ' M  mark/unmark the current file for the next download'CR
          SAY ' N  displays all descriptions without pausing. CTRL-E to Exit!'CR
          SAY ' R  displays file as text. - ONLY FILES THAT END IN .TXT -'CR
          SAY ' Q  returns to the main menu(s). (Quit)'CR
          SAY CR
          CALL waiting()
          IF waitchar='Q' THEN LEAVE browseloop
        END
      ELSE IF brcom='L' & level>sysoplevel THEN
        DO
          curdir=PRAGMA('D')
          IF getinput(1 1 'Rename' argname '? (Ny) > ')='Y' THEN
            DO
              newarg=getinput(0 0 'Rename' argname 'to ')
              IF newarg~='' THEN
                DO
                  IF is_here(newarg) THEN ITERATE browseloop
                  IF wi=999999 THEN ITERATE browseloop
                  IF EXISTS(libpath||filedir'/'newarg) THEN
                    DO
                      SAY CR
                      SAY '***' newarg 'already exists!'CR
                      SAY CR
                      ITERATE browseloop
                    END
                  junk=getinput(1 1 'Are you SURE you want to rename' argname 'to' newarg'? (Ny) ')
                  IF junk='Y' THEN
                    DO
                      lynes.2=OVERLAY(newarg,lynes.2,7,25)
                      comment=WORD(STATEF(arg),8)
                      CALL DELETE(arg)
                      arg=bbspath'FileNotes/'plaindir'/'newarg
                      CALL savelines(arg)
                      IF comment='' THEN
                        DO
                          mpath=libpath||plaindir
                          IF RENAME(mpath'/'argname,mpath'/'newarg)=0 THEN
                            SAY 'Rename failed on main file!'CR
                        END
                      ELSE
                        DO
                          t=LASTPOS('/',comment)
                          IF t=0 THEN t=LASTPOS(':',comment)
                          mpath=LEFT(comment,t-1)
                          IF RENAME(comment,mpath'/'newarg)=1 THEN
                            ADDRESS COMMAND 'C:FileNote' arg mpath'/'newarg
                          ELSE SAY 'Rename failed on external file!'CR
                        END
                      files.brfilenum=STRIP(WORD(files.brfilenum,1)) newarg
                      anum=files.brfilenum.0
                      alpha.anum=OVERLAY(newarg,alpha.anum,1,WORDINDEX(alpha.anum,2)-2)
                      CALL send2log('RENAME:' argname 'to' newarg 'in' plaindir)
                      argname=newarg
                      sortalphaflag=1
                      savefileflag=1
                      CALL DELETE(libpath||plaindir'/.'STRIP(LEFT(plaindir,15)))
                    END
                END
            END
          IF getinput(1 1 'Move' argname '? (Ny) > ')='Y' THEN
            DO
              IF chdir()=0 THEN
                DO
                  IF UPPER(dirs.dirnum)~=UPPER(WORD(files.brfilenum,1)) THEN
                    DO
                      CALL readlines(arg 1)
                      CALL movefile(brfilenum dirs.dirnum)
                    END
                END
            END
          IF savefileflag>0 THEN CALL savefilelist()
          CALL setdir(curdir)
        END
      ELSE IF brcom='N' THEN
        DO
          brfilenum=brfilenum-1
          nonstop=1
          SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def||CR
          SAY CR
          CALL DELAY(99)
          brcom=''
        END
      ELSE IF brcom='C' THEN
        DO
          temp=STRIP(WORD(STATEF(arg),8))
          IF temp='' THEN temp=libpath||plaindir'/'argname
          CALL Contents.rexx(temp)
          IF EXISTS('RAM:CONTENTS') THEN
            DO
              CALL cleanline(1)
              CALL showtext('RAM:CONTENTS' 0)
              IF waitchar~='Q' THEN CALL waiting()
              nonstop=0
            END
          ELSE SAY pen3'Not an archived file.'def||CR
        END
      ELSE IF brcom='D' THEN
        DO
          arg2=arg
          arg=brfilenum
          CALL dload()
          arg=arg2
        END
      ELSE IF brcom='E' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
              firstedit=5
              IF level>sysoplevel THEN firstedit=1
              CALL bbsEd.rexx(firstedit arg name TRUNC(maxtime-TIME('E'))-28)
              CALL checkfilechanges()
            END
        END
      ELSE IF brcom='K' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
              IF getinput(1 1 pen3'Do you really want to kill this file? (nY) >'def)~='N' THEN
                DO
                  tempnum=WORD(lynes.1,2)
                  IF tempnum=lastfile THEN
                    DO
                      CALL DELETE(bbspath'Numbers/LastFile')
                      CALL DELAY(28)
                      lastfile=lastfile-1
                      CALL countcheck('Numbers/LastFile' lastfile)
                    END
                  files.tempnum=''
                  tempnum2=files.tempnum.0
                  alpha.tempnum2='0 0' tempnum '100'
                  savefileflag=1
                  IF SHOW('P','BBBBS_LOCAL') THEN CALL savefilelist()
                  finfo=STATEF(arg)
                  IF WORDS(finfo)>7 THEN argname=WORD(finfo,8)
                  CALL DELETE(argname)
                  CALL DELETE(arg)
                  CALL send2log('Killed:' argname)
                  SAY argname pen3'has been deleted.'def||CR
                  CALL DELETE(libpath||plaindir'/.'STRIP(LEFT(plaindir,15)))
                END
            END
        END
      ELSE IF brcom='R' & (endtest='.TXT' | UPPER(argname)='.'UPPER(STRIP(LEFT(plaindir,15)))) THEN
        DO
          vcount=WORD(lynes.2,7)+1
          lynes.2=STRIP(DELWORD(lynes.2,7,1)) vcount
          edtype=''
          CALL savelines(arg)
          CALL showtext(argname 1)
        END
      ELSE brfilenum=brfilenum-1
    END
END
CALL setdir(brdir)
waitchar=''
IF nonstop THEN CALL waiting()
nonstop=0
CALL savedata(0)
RETURN


movefile:
PARSE ARG fnum movdir .
fromdir=STRIP(WORD(files.fnum,1))
farg=STRIP(WORD(files.fnum,2))
md=libpath||movdir
mf=md'/'farg
fd=libpath||fromdir
ff=fd'/'farg
CALL DELETE(md'/.'STRIP(LEFT(movdir,15)))
CALL DELETE(fd'/.'STRIP(LEFT(fromdir,15)))
fn=bbspath'FileNotes/'fromdir'/'farg
commen=WORD(STATEF(fn),8)
IF commen~='' THEN
  DO
    ff=commen
    n=LASTPOS('/',ff)
    IF n>1 THEN
      DO
        xf=SUBSTR(ff,n+1)
        tfd=LEFT(ff,n-1)
        n=LASTPOS('/',tfd)
        IF n=0 THEN n=LASTPOS(':',tfd)
        IF n>0 THEN
          DO
            tmd=LEFT(tfd,n)||movdir
            SAY 'Rename external file'pen3 ff||def||CR
            IF getinput(1 1 '                  to'pen3 tmd'/'farg||def'? (Ny) > ')='Y' THEN
              DO
                fd=tfd
                md=tmd
                mf=md'/'farg
                commen=md'/'xf
              END
            ELSE IF getinput(1 1 '          or move to'pen3 mf||def'? (Ny) > ')='Y' THEN
              DO
                fd=tfd
                commen=''
              END
          END
      END
  END
CALL MAKEDIR(md)
IF RENAME(ff,mf)=0 THEN
  DO
    ADDRESS COMMAND 'C:COPY' ff mf
    IF EXISTS(mf) THEN
      IF DELETE(ff)~=1 THEN SAY pen3'Unable to delete'def ff||pen3'.'def||CR
  END
files.fnum=movdir farg
lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1)
lynes.3=STRIP(lynes.3) movdir
CALL MAKEDIR(bbspath'FileNotes/'movdir)
mn=bbspath'FileNotes/'movdir'/'farg
CALL savelines(mn)
ndx=files.fnum.0
dnum=finddirnum(movdir)
alpha.ndx=OVERLAY(RIGHT(dnum,2) movdir,alpha.ndx,31,15)
IF EXISTS(mn) THEN
  DO
    CALL DELETE(fn)
    comm='C:FileNote' mn
    IF commen~='' THEN comm=comm commen
    ADDRESS COMMAND comm
  END
savefileflag=1
line='Moved:' fromdir'/'farg 'to' movdir
CALL send2log(line)
SAY line||CR
RETURN


textsearch:
ARG sfile' 'sarg
IF sarg='' THEN RETURN 0
x=OPEN(f,sfile,'R')
IF x=0 THEN RETURN 0
stemp=UPPER(READCH(f,65000))
CALL CLOSE(f)
retflag=0
IF POS(sarg,stemp)>0 THEN retflag=1
DROP stemp
RETURN retflag


bbsSEARCH:
smenu=menu
test=UPPER(LEFT(arg,1))
IF test='F' THEN smenu='FILE'
IF test='M' THEN smenu='MSG'
IF test='U' THEN smenu='MAIN'
IF smenu='ALL' THEN
  DO
    junk=getinput(1 1 'Search ['pen3'F'def']iles ['pen3'M'def']essages or ['pen3'U'def']sers (fmu) > ')
    IF junk='F' THEN smenu='FILE'
    ELSE IF junk='M' THEN smenu='MSG'
    ELSE IF junk='U' THEN smenu='MAIN'
    ELSE RETURN
  END
IF WORDS(arg)>1 THEN searcharg=UPPER(SUBSTR(arg,WORDINDEX(arg,2)))
ELSE searcharg=getinput(0 0 pen3'Search Phrase: 'def)
IF LENGTH(STRIP(searcharg))=0 THEN RETURN
searcharg=COMPRESS(searcharg,'*')
CALL send2log('SEARCH:' smenu 'for' searcharg)
IF smenu='NEW' | smenu='MAIN' THEN
  DO
    SAY 'Searching Userlist...'lineup||CR
    CALL FileList(bbspath'Users/*'searcharg'*',sl)
    SAY 'Found' sl.0 'matches                    'CR
    DO i=1 TO sl.0
      SAY sl.i||CR
      IF ~nonstop THEN
        IF i//linesperpage=0 THEN
          IF waiting2() THEN LEAVE i
    END
    DROP sl.
  END
IF smenu='MSG' THEN
  DO
    CALL SETCLIP('BBSMSG_SEARCH',searcharg)
    SAY lm
    CALL bbsMsg.rexx(maxtime-TRUNC(TIME('E')) name password)
  END
IF smenu='FILE' THEN
  DO
    lne=pen3'Searching'
    curdironly=0
    IF getinput(1 1 'Search one library only? (Ny) > ')='Y' THEN
      DO
        IF chdir()>0 THEN RETURN
        curdironly=1
        lne=lne 'the'def plaindir pen3'library'
        SAY CR
      END
    ELSE
      DO
        lne=lne 'all file libraries'
        SAY CR
        SAY pen3'WARNING!'def 'Searching' RIGHT(files.0,5) '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!'CR
      END
    test=getinput(1 1 '   ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ')
    IF test='Q' THEN RETURN
    SAY CR
    SAY lne 'for'def UPPER(searcharg)||CR
    SAY pen3' - To ABORT, press CTRL-E -'def||CR
    SAY CR
    IF test~='F' THEN
      DO
        CALL fileheader()
        IF curdironly=1 THEN
          DO
            af=libpath||dirs.dirnum'/.'STRIP(LEFT(dirs.dirnum,15))
            IF EXISTS(af) THEN
              DO
                CALL readlines(af 1)
                DO i=1 TO lynes.0
                  CALL busywait(8 i lynes.0)
                  tempnum=POS(UPPER(searcharg),UPPER(lynes.i))
                  IF tempnum>0 THEN
                    DO
                      CALL busywait(4 0)
                      SAY lynes.i||CR
                      SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def||CR
                      CALL busywait(4 1)
                    END
                END
              END
          END
        IF curdironly=0 | ~EXISTS(af) THEN
          DO i=1 TO alpha.0
            CALL busywait(60 i alpha.0)
            ii=WORD(alpha.i,4)
            IF ii>level THEN ITERATE i
            IF curdironly=1 & ii~=dirnum THEN ITERATE i
            ii=WORD(alpha.i,3)
            IF POS(UPPER(WORD(files.ii,1)),data.21)>0 THEN ITERATE i
            tempnum=POS(UPPER(searcharg),UPPER(alpha.i))
            IF tempnum>0 THEN
              DO
                CALL busywait(4 0)
                SAY alpha.i||CR
                SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def||CR
                CALL busywait(4 1)
              END
          END
      END
    ELSE
      DO
        cck=countcheck('Numbers/LastFile' 0)
        nonstop=1
        DO i=1 TO cck
          IF i//50=0 THEN CALL checkdcd()
          iii=cck+1-i
          IF files.iii='' THEN ITERATE i
          ii=files.iii.0
          ii=WORD(alpha.ii,4)
          IF ii>level THEN ITERATE i
          IF curdironly=1 & ii~=dirnum THEN ITERATE i
          IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i
          farg=WORD(files.iii,1)'/'WORD(files.iii,2)
          SAY '1B'x'M' RIGHT(farg,40) LEFT(iii,7)||CR
          IF textsearch(bbspath'FileNotes/'farg searcharg) THEN
            DO
              savei=i
              CALL readlines(bbspath'FileNotes/'farg 1)
              nonstop=1
              CALL seelines(2)
              i=savei
              SAY CR
              SAY CR
            END
        END
      END
    CALL busywait(4 0)
  END
searcharg=''
nonstop=0
SAY CR
IF i<999999 THEN SAY lineup'All available items have been searched.                        'CR
SAY CR
CALL waiting()
RETURN


finddirnum:
ARG fdirname .
DO fdir=1 TO 99
  IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir
END
RETURN 100


writebuffer:
PARSE ARG bufname .
Capture OFF
CALL DELETE(bufname)
SAY 'Type 'pen3'/E'def' or 'pen3'/S'def' on a new line to Exit and Save.'CR
IF EXISTS(bufname) THEN
  DO
    CALL DELAY(56)
    CALL DELETE(bufname)
    CALL DELAY(56)
  END
CaptWrap 74
Send pen3
Capture bufname
Send def
TimeOut 120
DO bufloop=1
  Wait '/E,/S,RING,NO CARRIER'
  Status 'L'
  test=LEFT(UPPER(cleanstring(0':'RESULT)),2)
  CALL checkdcd()
  IF test='/E' | test='/S' | test='/X' THEN LEAVE bufloop
END
IF test~='/X' THEN Send '\b\b'pen3
Capture OFF
CALL checkdcd()
TimeOut maxidle
SAY def||CR
startnum=lynes.0+1
CALL readlines(bufname startnum)
CALL wrapbuf(startnum)
QUEUE CR
RETURN


wrapbuf:
ARG startnum .
CALL cleanline(1)
SAY pen3'Wordwrapping...'def||CR
lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
lynes.startnum=cleanstring(2':'lynes.startnum)
DO wi=startnum WHILE wi<=lynes.0
  wj=wi+1
  lynes.wj=TRANSLATE(lynes.wj,' ','09'x)
  lynes.wj=cleanstring(2':'lynes.wj)
  IF LENGTH(lynes.wi)>75 THEN
    DO
      testchar=''
      IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
      IF testchar=' ' | testchar='.' | testchar=':' THEN
        DO
          DO wjj=lynes.0 TO wi+1 BY -1
            wk=wjj+1
            lynes.wk=lynes.wjj
          END
          lynes.wj=''
          lynes.0=lynes.0+1
        END
      DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
        IF WORDS(lynes.wi)=1 THEN
          lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
        lynes.wj=WORD(lynes.wi,wl) lynes.wj
        lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
      END
    END
END
RETURN


seelines:
ARG fancy .
DO i=1 TO lynes.0
  IF fancy=0 THEN SAY lynes.i||def||CR
  ELSE
    DO
      IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
      ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
        SAY pen3||lynes.i||def||CR
      ELSE SAY lynes.i||CR
      IF fancy=2 & colorflag=1 THEN
        DO
          IF searcharg~='' THEN
            DO
              testpos=POS(UPPER(searcharg),UPPER(lynes.i))
              IF testpos>0 THEN
                SAY LEFT(' ',testpos-1)||pen3||lineup||UPPER(searcharg)||def||CR
            END
          IF i=1 THEN
            IF WORD(lynes.1,3)='Reply' THEN
              DO
                testpos=WORDINDEX(lynes.1,3)
                SAY LEFT(' ',testpos-1)||pen3||lineup||SUBSTR(lynes.1,testpos)||def||CR
              END
        END
    END
  IF i//linesperpage=0 & i<lynes.0 THEN
    IF waiting2() THEN LEAVE i
END
nonstop=0
RETURN


readlines:
CALL CLOSE(f)
PARSE ARG tempname readstart .
IF ~readopen(tempname) THEN RETURN 1
IF readstart<2 THEN lynes.=''
DO ri=readstart
  line=READLN(f)
  IF EOF(f) THEN BREAK
  lynes.ri=line
END
lynes.0=ri-1
CALL CLOSE(f)
DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
END
lynes.0=ri
RETURN 0


savelines:
PARSE ARG tempname .
IF EXISTS(tempname) & edtype='MAIL' THEN
  DO
    ok=OPEN(f,tempname,'A')
    IF ok~=0 THEN CALL WRITELN(f,LEFT('',74,'^'))
  END
ELSE ok=OPEN(f,tempname,'W')
IF ok=0 THEN
  DO
    line='***' tempname 'failed to open for saving!'
    CALL send2log(line)
    SAY line||CR
    RETURN 1
  END
DO wi=1 TO lynes.0
  CALL WRITELN(f,lynes.wi)
END
CALL CLOSE(f)
RETURN 0


sortuserlist:
uf=bbspath'Lists/USERS'
IF sortuserflag THEN CALL DELETE(uf)
sortuserflag=0
IF ~EXISTS(uf) THEN
  DO
    users=bbsSortUsers.rexx(bbspath bbsname)
    RETURN
  END
ELSE
  DO
    IF OPEN(f,uf,'R')=0 THEN RETURN
    users=0
    DO i=1
      dat=READCH(f,65000)
      IF EOF(f) THEN LEAVE i
      users=users+WORDS(dat)
    END
    CALL CLOSE(f)
  END
SAY CENTER(RIGHT(users,8) 'Users on'pen3 bbsname,74)||def||CR
RETURN


showuserlist:
IF data.5='' THEN line='Here are the EMail names of the' users 'users on' bbsname '.'
ELSE line='   'users 'users. Use these names to address messages.'
SAY pen3||line||def||CR
CALL showtext(bbspath'Lists/USERS' 1)
IF data.5~='' THEN CALL waiting()
RETURN


msgcount:
ARG countdir .
lastmess=0
totmsgs=0
unred=0
IF ~EXISTS(msgpath||countdir) THEN RETURN
IF STATEF(msgpath||countdir)=msg.countdir.1 THEN totmsgs=msg.countdir.0
ELSE
  DO
    totmsgs=WORDS(SHOWDIR(msgpath||countdir))
    msg.countdir.0=totmsgs
    msg.countdir.1=STATEF(msgpath||countdir)
  END
IF countdir>level | FIND(data.21,i)>0 THEN RETURN
lastread.countdir=WORD(data.22,countdir)
IF ~DATATYPE(lastread.countdir,'W') THEN lastread.countdir=0
lastmess=countcheck('Numbers/LastMessage'countdir 0)
IF lastread.countdir<0 THEN RETURN
firstmess=countcheck('Numbers/FirstMessage'countdir 0)
IF lastread.countdir<firstmess THEN lastread.countdir=firstmess-1
IF lastmess>0 THEN
  IF lastread.countdir>=0 THEN
    DO
      IF lastread.countdir<(firstmess-1) THEN lastread.countdir=firstmess-1
      unred=lastmess-lastread.countdir
      IF unred>totmsgs THEN unred=totmsgs
      IF unred>0 | ~logonflag THEN
        DO
          cline=RIGHT(unred,5) 'new of' RIGHT(lastmess,5) 'messages,'
          cline=cline RIGHT(totmsgs,5) 'still online in'
          cline=cline RIGHT(countdir,2)',' msg.countdir
          SAY pen6||cline||def||CR
        END
    END
RETURN


counts:
SAY CR
SAY 'Working...'CR
SAY CR
temp=''
DO i=1 TO 4
  temp=temp||CENTER(copyright.i,75)||'0D0A'x
END
CALL SETCLIP('BBS_copyright',temp||CR)
CALL bbsSTATS.rexx(name colorflag 0 emailonline grand grand2 files.0 users)
SAY CR
CALL waiting2()
IF waitchar='Q' THEN RETURN
CALL showmarked(1)
CALL logonstats()
nonstop=0
CALL waiting()
RETURN


countmail:
SAY '   Counting online email...'lineup||CR
emailonline=0
t=SHOWDIR(bbspath'Users')
DO ti=1 TO WORDS(t)
  emailonline=emailonline+WORDS(SHOWDIR(bbspath'Email/'WORD(t,ti)))
END
SAY lineup'       'emailonline' letters online.'CR
RETURN


hourly:
IF level=99 & nonstop~=1 THEN
  DO
    IF getinput(1 1 'Zero The Hourly Averages? (Ny) > ')='Y' THEN
      ADDRESS COMMAND 'C:Delete >*' bbspath'Numbers/Hourly/#?'
    CALL cleanline(1)
  END
SAY lm
CALL ShowHourly.rexx(name linesperpage colorflag nonstop)
RETURN


logonstats:
IF level=0 THEN RETURN
SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I') lastontime||CR
tempnum=countcheck('Numbers/LastFile' 0)-lastbrowse
IF tempnum>files.0 THEN tempnum=files.0
line=RIGHT(countcheck('Numbers/LastFile' 0),5) 'uploaded,'
line=line RIGHT(files.0,5) 'files online.'CR
IF tempnum>0 THEN SAY RIGHT(tempnum,5) 'new of' line
ELSE SAY '   No new of' line
totmsg=0
grand=0
grand2=0
DO i=1 TO 99
  IF msg.i='' THEN ITERATE i
  CALL msgcount(i)
  totmsg=totmsg+unred
  grand=grand+totmsgs
  grand2=grand2+lastmess
END
line=RIGHT(grand2,5) 'messages,' RIGHT(grand,5) 'still online.'||CR
IF totmsg>0 THEN SAY RIGHT(totmsg,5) 'new of' line
ELSE SAY '   No new of' line

callsleft:
test=WORD(data.11,9)
IF test<1 THEN
  DO
    IF DATE('S')=WORD(data.13,1) THEN
      DO
        line=pen0||bak1' Attention! 'def 'This is your last call for'
        line=line DATE('W')',' DATE()
      END
    ELSE line='It''s after midnight here, you may call' WORD(data.11,5) 'more times today.'
  END
ELSE
  DO
    line='You may call' test 'more time'
    IF test~=1 THEN line=line's'
    line=line 'today.'
  END
SAY line||CR
RETURN


checkdcd:
IF GETCLIP('BBS_interpret')='' THEN
  DO
    dcd
    IF RC=0 THEN
      DO
        DO dcds=1 TO 3  /* 5 second delay */
          CALL DELAY(50)
          dcd
          IF RC~=0 THEN RETURN
        END
        dcd
        IF RC=0 THEN
          DO
            SAY CR
            Capture OFF
            Remote OFF
            CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
            line='^^^^^ LOST CARRIER! ^^^' DATE() TIME() '^^^^^'
            SAY line||CR
            Send '\dATH1\r'
            CALL send2log(line)
            CALL sound('LOST')
            IF newpassword='' THEN SIGNAL DONE
            ELSE SIGNAL OUT
          END
      END
  END
CALL checkexternal()
RETURN


sound:
ARG snd
IF bbsprefs.13=1 THEN RETURN
ADDRESS AREXX bbsSounds.rexx bbspath'Sounds/' snd
RETURN


checkexternal:
xmsg=GETCLIP('BBS_MESSAGE')
Capture
IF RC=0 & xmsg~='' & uldlflag=0 THEN
  DO
    SAY CR
    SAY bak2' Message From BBBBS: 'def||CR
    SAY xmsg||CR
    SAY CR
    CALL SETCLIP('BBS_MESSAGE')
    CALL waiting()
  END
xstring=GETCLIP('BBS_interpret')
IF xstring~='' THEN
  DO
    CALL SETCLIP('BBS_interpret')
    INTERPRET xstring
  END
xcom=GETCLIP('BBS_COMMAND')
IF xcom~='' THEN
  DO
    CALL SETCLIP('BBS_COMMAND')
    IF POS('G',xcom)>0 THEN SIGNAL LOGOUT2
    IF opt~='' THEN
      DO
        IF POS('B',xcom)>0 THEN test='/X'
        IF POS('L',xcom)>0 THEN CALL uplevel()
        IF POS('M',xcom)>0 THEN CALL validate('DEF.MEMBER')
        IF POS('R',xcom)>0 THEN CALL upratio()
        IF POS('T',xcom)>0 THEN CALL uptime()
        IF POS('V',xcom)>0 THEN CALL validate('DEF.CBV')
      END
    IF POS('C',xcom)>0 THEN CALL chat()
  END
RETURN


chat:
chatrequest=0
chattime=TIME('E')
SAY 'Entering chat mode with sysop.'CR
MSG pen3'- Press backslash [\] to exit -'def
SAY 'Press [RETURN] twice to tell' sysop 'you are finished typing.'CR
SAY CR
OPTIONS PROMPT ''
string=''
DO WHILE(string~='\')
  PULL string
  CALL checkdcd()
END
maxtime=maxtime+(TIME('E')-chattime)%1
RETURN


readopen:
PARSE ARG fname
ok=OPEN(f,fname,'R')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for reading!'
SAY line||CR
CALL send2log(line)
RETURN 0


writeopen:
PARSE ARG fname
CALL CLOSE(f)
ok=OPEN(f,fname,'W')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for writing!'
SAY line||CR
CALL send2log(line)
RETURN 0


set_grand:
SAY 'Setting up public message conferences...'CR
grand=0
DO i=1 TO 99
  IF msg.i='' THEN ITERATE i
  msg.i.0=WORDS(SHOWDIR(msgpath||i,'F'))
  msg.i.1=STATEF(msgpath||i)
  grand=grand+msg.i.0
END
RETURN


checkstats:          /* clip is set and cleared by stats programs */
IF TIME('H')>3 & GETCLIP('BBS_STAT')='' THEN
  DO
    IF WORD(STATEF(bbspath'Logs/Numbers.dat'),5)<DATE('I') THEN
      ADDRESS AREXX bbsNumbers.rexx
    ELSE IF EXISTS(bbspath'Information/STATS.ULDL') THEN
      DO
        lfinfo=STATEF(bbspath'Information/STATS.ULDL')
        IF WORD(lfinfo,5)<DATE('I') THEN
          DO
            ADDRESS AREXX bbsULDL.rexx
            CALL DELAY(99)
          END
      END
    IF TIME('H')>4 & EXISTS(bbspath'Information/STATS.USER') THEN
      DO
        ufinfo=STATEF(bbspath'Information/STATS.USER')
        IF WORD(ufinfo,5)<DATE('I') THEN
          DO
            ADDRESS AREXX bbsUSER.rexx
            CALL DELAY(99)
          END
      END
    IF grand>SYSTEM_MSG_LIMIT & TIME('H')>5 & TIME('H')<9 THEN
      DO
        SAY 'Doing Message Conference Maintenence...'CR
        Send 'ATH1\r'
        CALL bbsMAINT.baud(SYSTEM_MSG_LIMIT sysop)
        CALL set_grand()
        Send 'ATZ\r'
      END
  END
RETURN


zerovars:
lastread.=0
totwrit.=0
data.=''
libs.=''
msgs.=''
clear_marked=0
sortalphaflag=0
savefileflag=0
sortuserflag=0
linesperpage=22
chatrequest=0
lastbrowse=0
buildalpha=0
uldlflag=0
terseflag=0
warnings=0
winnings=0
menuflag=0
nonstop=0
libtext=1
dirnum=1
msgdir=1
level=0
newfilesflag=0
newfilesdate=''
newpassword=''
replymsg=''
waitchar=''
string=''
name=''
city='?'
opt=''
clr=''
RETURN


SYNTAX:
FAILURE:
lin.1=''ERRORTEXT(RC)''
lin.2=SIGL-1     SOURCELINE(SIGL-1)
lin.3=SIGL ''SOURCELINE(SIGL)''
lin.4=SIGL+1     SOURCELINE(SIGL+1)
DO er=1 TO 4
  IF level>sysoplevel THEN SAY lin.er||CR
  CALL send2log(lin.er)
END
CALL CLOSE(f)
IF newpassword='' THEN SIGNAL DONE  /* no user logged on, quit quietly */
SAY CR
CALL checkdcd()
waitchar=''
IF data.1~='' & data.5~='' & data.20~='' THEN CALL savedata(0)
SIGNAL RESTART


BREAK_E:
CALL CLOSE(f)
SAY pen3'*** CTRL-E BREAK ***'def||CR
waitchar=''
string=''
nonstop=0
rnonstop=0
brostop=0
i=999999
wi=999999
ui=999999
ni=-1
QUEUE CR
RETURN 0


HALT:
BREAK_C:
SIGNAL OFF BREAK_C
SIGNAL OFF BREAK_E
CALL CLOSE(f)
IF newpassword='' THEN
  DO
    CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
    SIGNAL DONE  /* no user logged on, quit quietly */
  END
CALL checkdcd()
SAY CR
IF warnings<1 THEN  /* just 1 warning */
  DO
    warnings=warnings+1
    SAY CR
    SAY CR
    SAY CR
    SAY 'If you didn''t press CTRL-C then...   HEY!    Wake up!'CR
    SAY '                                     Auto-disconnect in' TRUNC(maxidle/60+.5) 'minutes!'CR
    SAY CR
    SAY 'If you DID press CTRL-C,  PLEASE  use CTRL-E next time instead.'CR
    SAY CR
    Remote OFF
    Send '^G\w^G\w^G^G^G^G'
    Remote ON
    waitchar=''
    string=''
    nonstop=0
    CALL SETCLIP('BBS_door')
    SIGNAL ON BREAK_C
    CALL waiting()
    SIGNAL RESTART
  END
CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
SAY 'No Activity For' TRUNC(maxidle/30+.5) 'minutes! -- Disconnecting.'CR
Send '\d'
CALL sound('TIMEOUT')
SIGNAL OUT

LOGOUT:
junk=getinput(1 1 pen3'Leave Feedback for SysOp? (Ny) > 'def)
IF junk='Y' THEN
  CALL editor(name maxtime-TRUNC(TIME('E')) 'MAIL' sysop . 0 0 'FEEDBACK')

LOGOUT2:
clr=''
CALL checkexternal()
SIGNAL OFF BREAK_E
CALL SETCLIP('BBS_level')
CALL callsleft()
secs=TIME('E')
mins=secs%60
secs=TRUNC(secs//60)
IF secs<10 THEN secs='0'secs
SAY CR
SAY 'Public  files   online: 'RIGHT(comma(files.0),9)||CR
SAY 'Public messages online: 'RIGHT(comma(grand),9)||CR
SAY CR
SAY 'Time used this call:' mins':'secs||CR
SAY 'Goodbye' name', thank you for calling' bbsname'.'CR
linesperpage=99
arg=bbspath'BBS_TEXT/GOODBYE'
IF EXISTS(arg) THEN
  DO
    CALL DELAY(14)
    CALL showtext(arg 0)
  END
SAY CR
IF bbsprefs.2 & ~terseflag THEN CALL doGrin()

OUT:
SIGNAL OFF BREAK_E
Remote OFF
data.18=winnings
line=left(name,16,' ') 'logged off at' time('C')
dcd
IF RC~=0 THEN Send '\ah'
IF data.20~='' THEN
  DO
    Status 'Y'
    elapsed=RESULT
    line=line 'Total:'elapsed
    PARSE VAR elapsed thour':'tmin':'.
    ADDRESS AREXX bbsHOURLY.rexx TIME('H') TIME('M')//60 thour tmin bbspath'Numbers/Hourly'
    PARSE VAR data.19 dhour 'hours' dmin 'minutes in' calls .
    IF ~DATATYPE(tmin,'W')  THEN tmin=0
    IF ~DATATYPE(thour,'W') THEN thour=0
    IF ~DATATYPE(dhour,'W') THEN dhour=0
    IF ~DATATYPE(dmin,'W')  THEN dmin=0
    IF ~DATATYPE(calls,'W') THEN calls=0
    IF thour=0 & tmin<3 THEN  /* free call if less than 3 minutes */
      DO
        wordloc=WORDINDEX(data.11,9)-1
        wordval=WORD(data.11,9)+1
        data.11=STRIP(LEFT(data.11,wordloc))
        data.11=data.11 wordval 'more calls today'
      END
    ELSE IF thour>0 | tmin>(maxtime/120) THEN /* over 50% mins used */
      CALL SETCLIP('BBS_FULLCALL',name TIME('M'))
    ufile=LEFT(DATE('S'),6)
    mmins=thour*60+tmin+countcheck('Usage/'ufile 0)
    CALL countcheck('Usage/'ufile mmins)
    mins=thour*60+tmin+countcheck('Numbers/Minutes' 0)
    CALL countcheck('Numbers/Minutes' mins)
    mins=thour*60+tmin+countcheck('Numbers/Minutes'bps 0)
    CALL countcheck('Numbers/Minutes'bps mins)
    cals=countcheck('Numbers/Calls' 0)+1
    CALL countcheck('Numbers/Calls' cals)
    cals=countcheck('Numbers/Calls'bps 0)+1
    CALL countcheck('Numbers/Calls'bps cals)
    thour=thour+dhour
    tmin=tmin+dmin+1
    IF tmin>59 THEN
      DO
        thour=thour+tmin%60
        tmin=tmin//60
      END
    data.19=thour 'hours' tmin 'minutes in' calls+1 'calls.'
    CALL SETCLIP('BBS_totalusage',mmins%60 mmins//60)
    CALL SETCLIP('BBS_userlogoff',TIME('C') DATE())
    CALL postuser(6)
    IF newfilesflag=1 THEN
      DO
        newfilesdate=DATE('S') TIME()
        lastbrowse=countcheck('Numbers/LastFile' 0)
      END
    IF clear_marked=1 THEN data.24=''
    CALL savedata(1)
    data.5=''
    IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') THEN
      DO
        IF sortalphaflag>0 | savefileflag>0 THEN
          CALL SETCLIP('BBS_QUICK_WAIT',1)
        ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
      END
    arg=''
    lastline=RIGHT(TIME('C'),7) LEFT(DATE(),6)
    lastline=lastline'  'RIGHT(city,40)
    lastline=OVERLAY(name,lastline,16,LENGTH(name)+1) RIGHT(bps,5)
    lastline=lastline' Time:'elapsed
    newpassword=''
    IF data.20=0 THEN lastline=OVERLAY('UNVALIDATED_USER',lastline,16,38)
    CALL send2last(lastline)
    CALL bbsLOGOFF.baud(name level elapsed)
    SAY lastline||def||CR
  END
CALL sound('LOGOFF')

OUT2:
CALL send2log(line)

DONE:
CALL send2log('')
logonflag=0
colorflag=1
CALL colors(1)

DONE2:
CBVflag=0
CALL setdir(libpath||dirs.1)
CALL SETCLIP('BBS_maxtime')
CALL SETCLIP('BBS_winnings')
CALL SETCLIP('BBS_minutes')
CALL SETCLIP('BBS_level')
CALL SETCLIP('BBS_door')
Capture
IF RC~=0 THEN Capture OFF
Send '\c\ah'
IF WORDS(bbsprefs.27)=8 THEN CALL dimBBcols()
ELSE IF bbsprefs.27=1 THEN CALL ScreenToBack('BAUD')
ELSE IF bbsprefs.27=2 THEN Screen OFF
ELSE CALL DELAY(14)
Remote OFF
baud maxbps
IF sortuserflag=0 & sortalphaflag=0 & savefileflag=0 & emailonline>=0 & buildalpha=0 THEN
  CALL DELAY(128)
ELSE
  DO
    CALL ATZreset()
    CALL DELAY(52)
    Send 'ATH1\r'
    CALL DELAY(128)
    Send 'ATH1\r'
    IF buildalpha~=0 THEN
      DO
        CALL BuildALPHA.rexx()
        sortalphaflag=0
        savefileflag=0
        buildalpha=0
      END
    IF sortuserflag=1 THEN
      DO
        CALL sortuserlist()
        IF SHOW('P','BBBBS_LOCAL') THEN
          DO
            CALL SETCLIP('BBS_localusers')
            CALL SETCLIP('BBS_mainusers',1)
          END
      END
    IF sortalphaflag>0 | savefileflag>0 | GETCLIP('BBS_resave')~='' THEN
      DO
        x=GETCLIP('BBS_resave')
        IF savefileflag>0 THEN CALL savefilelist2()
        ELSE IF x='' THEN CALL savealphalist()
        x=GETCLIP('BBS_resave')
        CALL SETCLIP('BBS_resave')
        IF x=1 THEN
          DO
            sortalphaflag=1
            savefileflag=1
            SIGNAL DONE2
          END
        IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
        CALL SETCLIP('BBS_QUICK_WAIT')
      END
    IF emailonline<0 THEN CALL countmail()
  END
IF bbsprefs.15=0 THEN  /* quit or restart? */
  DO
    IF words(bbsprefs.27)=8 THEN CALL setBBcols()
    CALL checkstats()
    EXIT
  END
IF STORAGE()<bbsprefs.15 THEN
  DO
    IF words(bbsprefs.27)=8 THEN CALL setBBcols()
    SAY CR
    SAY '*** Unsafe memory level!'CR
    line='*** Less than' bbsprefs.15 'bytes available, BBBBS has been unloaded.'
    SAY line||CR
    SAY CR
    CALL send2log(line)
    EXIT
  END
CALL CLOSE(f)
CALL CLOSE(log)
bad_atz=ATZreset()   /* reset modem */
CALL zerovars()
DO FOREVER
  IF GETCLIP('BBS_QUIT')='QUIT' THEN
    DO
      CALL SETCLIP('BBS_QUIT')
      CALL SETCLIP('BBS_localfiles')
      CALL SETCLIP('BBS_localusers')
      Send '\c'
      IF words(bbsprefs.27)=8 THEN CALL setBBcols()
      IF SHOW('P','BBSPOST') THEN ADDRESS 'BBSPOST' 'QUIT'
      EXIT
    END
  xstring=GETCLIP('BBS_RESET')
  IF xstring~='' THEN SIGNAL RESET
  xstring=GETCLIP('BBS_interpret')
  IF xstring~='' THEN
    DO
      CALL SETCLIP('BBS_interpret')
      INTERPRET xstring
      SIGNAL DONE2
    END
  IF GETCLIP('BBS_localfiles')>1 THEN
    DO
      CALL DELAY(150)
      Send 'ATH1\r'
      CALL SETCLIP('BBS_localfiles')
      CALL loadfiles()
      CALL loadalpha(1)
      SIGNAL DONE2
    END
  IF GETCLIP('BBS_localusers')~='' THEN
    DO
      CALL DELAY(150)
      Send 'ATH1\r'
      CALL SETCLIP('BBS_localusers')
      sortuserflag=1
      CALL sortuserlist()
      SIGNAL DONE2
    END
  IF GETCLIP('BBS_email')~='' THEN
    DO
      x=GETCLIP('BBS_email')
      CALL SETCLIP('BBS_email')
      IF DATATYPE(x,'W') THEN
        IF emailonline>-1 THEN emailonline=emailonline+x
    END
  IF bad_atz=1 THEN bad_atz=ATZreset()
  dcd
  IF RC~=0 THEN Send '\ah'
  IF GETCLIP('BBS_SLAVE')=1 THEN
    DO
      Quiet ON
      IF SHOW('P','BBS_SLAVE') THEN ADDRESS 'BBS_SLAVE' 'QUIT'
      cm=''
      t=WAITPKT('BBBBS')
      DO i=1
        p=GETPKT('BBBBS')
        IF p='0000 0000'x THEN LEAVE i
        cm=GETARG(p)
        t=REPLY(p,0)
      END
      Quiet OFF
      x=GETCLIP('BBS_SLAVE_RATE')
      CALL SETCLIP('BBS_SLAVE_RATE')
      IF cm='QUIT' THEN EXIT
      SAY 'CONNECT' x||CR
      SIGNAL LOGON
    END
  wres=''
  Wait 'RING'
  wres=RESULT
  IF wres='RING' THEN
    DO
      Send 'ATA\r'
      Timeout 45  /* wait 45 seconds for connect */
      wres=''
      Wait 'CONNECT,NO CARRIER,RING,+FCON,+FHNG'
      wres=RESULT
      CALL DELAY(28)
      IF wres~='CONNECT' THEN SIGNAL DONE2
      CALL DELAY(114)
      SAY ' 'CR
      CALL DELAY(28)
      SAY ' 'CR
      dcd
      IF RC=0 THEN
        DO
          CALL DELAY(128)
          dcd
          IF RC=0 THEN
            DO
              CALL DELAY(128)
              dcd
              IF RC=0 THEN SIGNAL DONE2
            END
        END
      CALL SETCLIP('BBS_interpret')
      CALL SETCLIP('BBS_MESSAGE')
      IF words(bbsprefs.27)=8 THEN CALL setBBcols()
      ELSE IF bbsprefs.27=2 THEN Screen ON
      ELSE CALL DELAY(114)
      SAY ''CR    /* reset text defaults */
      SIGNAL LOGON
    END
  ELSE CALL checkstats()
  IF GETCLIP('BBS_resave')~='' THEN SIGNAL DONE2
END
EXIT


dimBBcols:
DO i=0 TO 7
  Send '\S'i'-'WORD('000 BA3 039 878 094 828 552 835',i+1)
END
RETURN


setBBcols:
DO i=0 TO 7
  Send '\S'i'-'WORD(bbsprefs.27,i+1)
END
RETURN


ATZreset:
TimeOut 10
Send 'ATZ\r'
Wait 'OK,RING'
IF RESULT~='OK' THEN
  DO
    Send '\d\wATZ\r'
    Wait 'OK'
    IF RESULT~='OK' THEN
      DO
        Send '\w\w+++\w\w\w\wATH\r'
        CALL sound('ATZ_FAIL')
        IF WORDS(bbsprefs.27)=8 THEN CALL setBBcols()
        ELSE IF bbsprefs.27=1 THEN CALL ScreenToFront('BAUD')
        ELSE IF bbsprefs.27=2 THEN Screen ON
        line='*** ATZ failed to reset!' TIME('C') DATE()
        SAY line'  Check your modem!!'CR
        CALL send2log(line)
        RETURN 1
      END
  END
TimeOut 45
Send '\dATH\r'
RETURN 0


getbaudrate: PROCEDURE
TRACE OFF
BaudRate
brate=RC
TRACE
RETURN brate


checkalias:
addressee=''
IF alias.0=0 THEN RETURN 0
DO i=1 TO alias.0
 IF UPPER(alias.i)=UPPER(string) THEN
  DO
   addressee=realname.i
   LEAVE i
  END
END
IF addressee='' THEN RETURN 0
string=''
SAY pen3'Email to 'def||addressee||CR
CALL editor(name maxtime-TRUNC(TIME('E')) 'MAIL' addressee . 0 0)
RETURN 0


upCBV:
ARG res .
temp=bbspath'Lists/CBV_USERS'
IF EXISTS(temp) THEN t2='A'
ELSE t2='W'
x=OPEN(f,temp,t2)
IF x=0 THEN RETURN 1
IF t2='W' THEN CALL WRITELN(f,'*** Call Back Verify Log ***')
temp=RIGHT(TIME('C'),7) COMPRESS(DATE())
temp=temp LEFT(name,24) RIGHT(telnum' RESULT:',20) res
CALL WRITELN(f,temp)
CALL CLOSE(f)
RETURN 0


CBV:
IF bbsprefs.22=0 THEN RETURN
SAY CR
CALL showtext(bbspath'BBS_TEXT/CBV_INFO' 1)
SAY CR
telnum=getinput(1 0 pen7'Please Enter Phone Number For Call Back: 'def )
mask=COMPRESS(XRANGE(),'0123456789-, @#*')
telnum=COMPRESS(telnum,mask)
IF telnum='' THEN RETURN
DO n=1 WHILE n<LENGTH(telnum) & ~DATATYPE(SUBSTR(telnum,n,1),'W')
END
IF SUBSTR(telnum,n,1)<2 THEN
  DO
    SAY 'No long distance numbers, please!'CR
    RETURN
  END
temp='The BBS will now call' telnum 'to verify. Correct? (Ny) > '
IF getinput(1 1 temp)~='Y' THEN RETURN
CALL sound('CBV')
telnum=COMPRESS(telnum)
data.27=STRIP(data.27 telnum)
SAY pen3'Logging Off. Callback to' telnum 'in 30 seconds.'def||CR
SAY 'When your modem rings, type  ATA  and press RETURN.'CR
SAY pen2'GoodBye for now,' name '.'def||CR
REMOTE OFF
Timeout 10
Send '\ah'
Wait 'OK,RING'
IF RESULT~='OK' THEN
  DO
    Send '\d'
    CALL DELAY(50)
    DO n=1 TO 10 WHILE ATZreset()=1
    END
  END
CALL DELAY(50)
Send 'ATH1\r'
SAY CR
CALL DELAY(99)
SAY CR
DO n=14 TO 1 BY -1
  MSG '1B'x'M' n*2 'seconds left before CBV callback...'
  CALL DELAY(99)
END
MSG lineup 'Beginning CBV callback...               '
SAY CR
Timeout 10
Send '\ah'
Wait 'OK'
IF RESULT~='OK' THEN
  DO
    Send '\d'
    CALL DELAY(50)
    DO n=1 TO 10 WHILE ATZreset()=1
    END
  END
CALL DELAY(50)
Send 'ATL3M1DT'telnum'\r'  /* M1 = Speaker ON, L3 = volume up */
Timeout 90
Wait 'CONNECT,NO CARRIER,BUSY,ERROR'
IF RESULT~='CONNECT' THEN
  DO
    CALL upCBV('FAILED')
    SIGNAL OUT
  END
REMOTE ON
DO i=20 TO 0 BY -1
  SAY CENTER(copyright.i,75)||CR
END
SAY CENTER(bbsname 'Call Back Identity Verification',74)||CR
SAY CR
CBVflag=1
Timeout maxidle
DO cnt=1 TO 3
  Namentr=getinput(1 0 pen3'    Enter Name: 'def)
  Namentr=cleanstring('1:'Namentr)
  IF Namentr=name THEN LEAVE cnt
END
DO count=1 TO 4
  IF cnt>3 | count>3 THEN
    DO
      SAY 'Incorrect Entry!'||CR
      SAY 'Verification Denied.'||CR
      SAY pen2'Leave a 'pen3'['pen7'C'pen3']omment'pen2'to SysOp,'CR
      SAY pen2'for manual verification.'CR
      SAY CR
      CALL upCBV('DENIED')
      SIGNAL OUT
    END
  pw=getinput(1 0 pen3'Enter Password: 'def)
  IF UPPER(pw)=data.5 THEN
    DO
      CALL upCBV('VERIFIED')
      v=GETCLIP('BBS_COMMAND')
      CALL SETCLIP('BBS_COMMAND',v'V')
      CBVflag=0
      RETURN
    END
END
RETURN


/* BBBBS.baud */